perm filename MATCH.CRM[PAT,LMM]2 blob
sn#045528 filedate 1973-05-18 generic text, type T, neo UTF8
␈↓ ↓⊗␈↓ εK EXPR]
␈↓ ↓⊗␈↓α(FILECREATED "18-MAY-73 4:42:12" MATCH.NEW)␈↓↓
␈↓ εK (SETQ EXPRESSION ('MATCH VAR PAT))
␈↓ ↓⊗
␈↓ εK (AND MUSTRETURN (SETQ POSTPONEDEFFECTS (NCONC1
␈↓ ↓⊗
␈↓ εK POSTPONEDEFFECTS
␈↓ ↓⊗ (LISPXPRINT (QUOTE MATCHVARS)
␈↓ εK MUSTRETURN)))
␈↓ ↓⊗ T)
␈↓ εK [AND POSTPONEDEFFECTS (SETQ EXPRESSION
␈↓ ↓⊗ (RPAQQ MATCHVARS
␈↓ εK ('AND EXPRESSION (COND
␈↓ ↓⊗ ((FNS MAKEMATCH 'MATCHTOP 'MATCH 'MATCHBIND 'MATCHELT
␈↓ εK ((CDR POSTPONEDEFFECTS)
␈↓ ↓⊗ 'MATCHEXP 'MATCHFIXED 'MATCHSUBPAT 'MATCHTAIL 'MATCHSOME
␈↓ εK (CONS (QUOTE PROGN)
␈↓ ↓⊗ 'MATCHWITHMEMB 'MATCHNNIL 'MATCHEXP1 LOCALPATVAR
␈↓ εK POSTPONEDEFFECTS))
␈↓ ↓⊗ 'MATCH&SET 'CDRLEN POSTPONE 'HEADP ABP RPLNODE)
␈↓ εK (T (CAR POSTPONEDEFFECTS]
␈↓ ↓⊗ (FNS ANALPATELT ANALPAT MAXANAL ANAL!PAT $? SKIP$I SKIP$
␈↓ εK (RETURN (COND
␈↓ ↓⊗ SKIP$ANY ELT? MEMBPAT? ARB? NOMATCHARB? NOMATCHELT?
␈↓ εK (BINDINGS (LIST (QUOTE PROG)
␈↓ ↓⊗ SUBPAT? NOMATCHARBCAR? NULLPAT? CANMATCHNIL)
␈↓ εK BINDINGS EXPRESSION))
␈↓ ↓⊗ (FNS EASYTORECOMPUTE EQTOMEMB FULLEXPANSION GENSYML MAKESUBST
␈↓ εK (T EXPRESSION])
␈↓ ↓⊗ MAKESUBST1 FORMEXPAND BIND BOUNDVAR RECOMPUTATION
␈↓ εK
␈↓ ↓⊗ MAKEVAR)
␈↓ εK␈↓α('MATCH␈↓↓
␈↓ ↓⊗ (FNS 'NLEFT 'NOT 'NOTLESSPLENGTH 'NTH 'NTH{NUMBER⎇ 'OR 'PLUS
␈↓ εK [LAMBDA (VAR PAT) (* Constructs match of
␈↓ ↓⊗ 'REPLACE 'SETQ←SIDE←EFFECT 'REPLACE←SIDE←EFFECT 'SETQ
␈↓ εK PAT against VAR -
␈↓ ↓⊗ 'SETVAR 'SOME 'AND '!AND OPTIMIZEAND 'CAR 'CDR 'EQ
␈↓ εK See 'MATCHTOP for global
␈↓ ↓⊗ 'EQLENGTH 'EQUAL 'LENGTH 'LISTP 'NULL 'LAST 'TAILP
␈↓ εK vars)
␈↓ ↓⊗ 'LDIFF 'RETURN)
␈↓ εK (PROG (TAIL (LEN 0))
␈↓ ↓⊗ (FNS PARSE PATPARSE NUMPATPARSE PATPARSE1 PATPARSE← BI12
␈↓ εK (COND
␈↓ ↓⊗ PATPARSEAT PACKLDIFF BISET BIRPLAC MAKEDEFAULT
␈↓ εK ((NULL PAT)
␈↓ ↓⊗ MAKE!DEFAULT)
␈↓ εK ('EQLENGTH VAR 0))
␈↓ ↓⊗ (FNS HEADP)
␈↓ εK ((NLISTP PAT)
␈↓ ↓⊗ (VARS POSTPONE←SIDE←EFFECTS VARDEFAULT LISTPCHK ORSETQFLG)
␈↓ εK (HELP "BAD PARSING - NLISTP PAT IN 'MATCH" PAT))
␈↓ ↓⊗ (BLOCKS * MATCHBLOCKS)
␈↓ εK ((NULL (SETQ TAIL (SKIP$I PAT)))
␈↓ ↓⊗ (PROP MACRO EVERY SOME)))
␈↓ εK
␈↓ ↓⊗␈↓α(DEFINEQ␈↓↓
␈↓ εK (* PAT is a list of $i's -
␈↓ ↓⊗
␈↓ εK SKIP$I returns the first tail after all $i's, sets
␈↓ ↓⊗␈↓α(MAKEMATCH␈↓↓
␈↓ εK the variable LEN to the length of the $i's)
␈↓ ↓⊗ [LAMBDA (VAR TOPPAT)
␈↓ εK
␈↓ ↓⊗ ('MATCHTOP VAR (PATPARSE (COPY TOPPAT])
␈↓ εK
␈↓ ↓⊗
␈↓ εK ('EQLENGTH VAR LEN))
␈↓ ↓⊗␈↓α('MATCHTOP␈↓↓
␈↓ εK ((NULLPAT? TAIL) (* PAT is a list of $i's
␈↓ ↓⊗ [LAMBDA (EXPR PAT MUSTBEMATCH)
␈↓ εK followed by a $)
␈↓ ↓⊗
␈↓ εK ('NOTLESSPLENGTH VAR LEN))
␈↓ ↓⊗ (* Generate expresion which will match PAT against
␈↓ εK [(NOT (ZEROP LEN))
␈↓ ↓⊗ VAR -
␈↓ εK
␈↓ ↓⊗ MUSTBEMATCH is a flag which says if the value of the
␈↓ εK (* PAT starts with a list of $i's -
␈↓ ↓⊗ expression must be NIL if no match occurs and non
␈↓ εK 'MATCHEXP is called here instead of 'MATCH because
␈↓ ↓⊗ NIL otherwise -
␈↓ εK the 'NTH expression might not be EASYTORECOMPUTE)
␈↓ ↓⊗ ORSETQFLG is flag for setting whether setqs that
␈↓ εK
␈↓ ↓⊗ might be NIL should be embedded in
␈↓ εK
␈↓ ↓⊗ (OR (SETQ --) T) -
␈↓ εK (COND
␈↓ ↓⊗ NULLCHK is flag for setting whether there is an
␈↓ εK ((NUMBERP LEN)
␈↓ ↓⊗ implicit -- at the end of each pattern -
␈↓ εK ('MATCH ('NTH{NUMBER⎇ VAR (ADD1 LEN))
␈↓ ↓⊗ LISTPCHK is flag for whether sub-patterns should
␈↓ εK TAIL))
␈↓ ↓⊗ check LISTP first -
␈↓ εK (T ('MATCHEXP ('NTH VAR ('PLUS 1 LEN))
␈↓ ↓⊗ VARDEFAULT is flag which says what the default
␈↓ εK TAIL]
␈↓ ↓⊗ meaning of a variable in a pattern is
␈↓ εK [(ELT? (CAR PAT))
␈↓ ↓⊗ (either set for (... Var←$1 ...) or QUOTE for
␈↓ εK (COND
␈↓ ↓⊗ (... 'var ...) or equal for
␈↓ εK ((NULLPAT? (CDR PAT))
␈↓ ↓⊗ (... =VAR ...)) -
␈↓ εK ('MATCHELT ('CAR VAR)
␈↓ ↓⊗ POSTPONE←SIDE←EFFECTS is a flag which says whether
␈↓ εK (CAR PAT)
␈↓ ↓⊗ side effects (... pat←expr ...) or
␈↓ εK MUSTBEMATCH))
␈↓ ↓⊗ (... var←pat ...) should be postponed and only done
␈↓ εK (T ('AND ('MATCHELT ('CAR VAR)
␈↓ ↓⊗ if the entire pattern matches)
␈↓ εK (CAR PAT)
␈↓ ↓⊗
␈↓ εK T NIL)
␈↓ ↓⊗
␈↓ εK ('MATCH ('CDR VAR)
␈↓ ↓⊗ (PROG (POSTPONEDEFFECTS SOMEVARS EXPRESSION BINDINGS VAR
␈↓ εK (CDR PAT]
␈↓ ↓⊗ (GENSYMVARLIST (QUOTE (NIL $$1 $$2 $$3 $$4
␈↓ εK (($? (CAR PAT))
␈↓ ↓⊗ $$5 $$6 $$7 $$8
␈↓ εK ('MATCHTAIL VAR (CDR PAT)))
␈↓ ↓⊗ $$9 $$10 $$11
␈↓ εK ((NLISTP (CAR PAT))
␈↓ ↓⊗ $$12 $$13 $$14
␈↓ εK (HELP (QUOTE "BAD PATTERN ELEMENT")
␈↓ ↓⊗ $$15 $$16 $$17)))
␈↓ εK PAT))
␈↓ ↓⊗ (EASYFNS (QUOTE (CAR CDR)))
␈↓ εK ((NLISTP (CAAR PAT))
␈↓ ↓⊗ (MUSTBEMATCH T)
␈↓ εK (SELECTQ
␈↓ ↓⊗ (NULLCHK T)
␈↓ εK (CAAR PAT)
␈↓ ↓⊗ (MUSTRETURN T))
␈↓ εK [← (* Only segment SETS get
␈↓ ↓⊗ [COND
␈↓ εK here)
␈↓ ↓⊗ ((EASYTORECOMPUTE EXPR)
␈↓ εK (COND
␈↓ ↓⊗ (SETQ VAR EXPR))
␈↓ εK ((NULL (CDR PAT)) (* Call 'MATCHBIND to
␈↓ ↓⊗ (T (BIND (LIST (SETQ VAR (GENSYML EXPR))
␈↓ εK rebind MUSTBEMATCH)
␈↓ ↓⊗ ('AND ('MATCHBIND VAR (LIST (CDDR (CAR PAT)))
␈↓ εK ('MATCHELT VAR (CDR (CAR PAT))
␈↓ ↓⊗ T NIL)
␈↓ εK MUSTBEMATCH))
␈↓ ↓⊗ ('SETQ←SIDE←EFFECT
␈↓ εK [(SUBPAT? (CDAR PAT))
␈↓ ↓⊗ (CADR (CAR PAT))
␈↓ εK
␈↓ ↓⊗ VAR ORSETQFLG)))
␈↓ εK (* (..1.. ! (..2..) ..3..) is the same as
␈↓ ↓⊗ [(OR (ARB? (CDDAR PAT))
␈↓ εK (..1.. ..2.. ..3..))
␈↓ ↓⊗ (AND (NOT (ELT? (CDDAR PAT)))
␈↓ εK
␈↓ ↓⊗ (HELP
␈↓ εK
␈↓ ↓⊗ "I'LL TRY TO DO THIS MATCH IF YOU RETURN T" PAT)
␈↓ εK ('MATCH VAR (NCONC (CDAR PAT)
␈↓ ↓⊗ ))
␈↓ εK (CDR PAT]
␈↓ ↓⊗
␈↓ εK ((EQ (CADAR PAT)
␈↓ ↓⊗ (* To match var against (x←seg ...), match against
␈↓ εK (QUOTE =))
␈↓ ↓⊗ (seg !tem← ...), and then set x to
␈↓ εK ('MATCHEXP ('HEADP (CDDAR PAT)
␈↓ ↓⊗ (LDIFF var tem))
␈↓ εK VAR)
␈↓ ↓⊗
␈↓ εK (CDR PAT)))
␈↓ ↓⊗
␈↓ εK ((EQ (CADAR PAT)
␈↓ ↓⊗ ('AND
␈↓ εK (QUOTE '))
␈↓ ↓⊗ ('AND
␈↓ εK ('MATCHEXP ('HEADP (KWOTE (CDDAR PAT))
␈↓ ↓⊗ ('MATCHBIND
␈↓ εK VAR)
␈↓ ↓⊗ VAR
␈↓ εK (CDR PAT)))
␈↓ ↓⊗ (CONS (CDDAR PAT)
␈↓ εK [(EQ (CDAR PAT)
␈↓ ↓⊗ (CONS (CONS (QUOTE !←)
␈↓ εK (QUOTE *))
␈↓ ↓⊗ (SETQ TEM (MAKEVAR T)))
␈↓ εK ('AND
␈↓ ↓⊗ (CDR PAT)))
␈↓ εK ('AND
␈↓ ↓⊗ T NIL)
␈↓ εK ('MATCHBIND
␈↓ ↓⊗ TEM)
␈↓ εK VAR
␈↓ ↓⊗ ('SETQ←SIDE←EFFECT
␈↓ εK (CONS (QUOTE $)
␈↓ ↓⊗ (CADAR PAT)
␈↓ εK (CONS (CONS (QUOTE !←)
␈↓ ↓⊗ ('LDIFF (COPY VAR)
␈↓ εK (SETQ TEM (MAKEVAR T)))
␈↓ ↓⊗ TEM)
␈↓ εK (CDR PAT)))
␈↓ ↓⊗ (AND ORSETQFLG (CANMATCHNIL (CDDAR PAT]
␈↓ εK T NIL)
␈↓ ↓⊗ (T (HELP "CAN'T DO THIS ← YET" PAT]
␈↓ εK TEM)
␈↓ ↓⊗ [-> (* Only segmentreplaces
␈↓ εK ('RETURN ('LDIFF (COPY VAR)
␈↓ ↓⊗ get here -
␈↓ εK TEM]
␈↓ ↓⊗ similar to ←)
␈↓ εK [(FMEMB (CADAR PAT)
␈↓ ↓⊗ (COND
␈↓ εK (QUOTE (← ->)))
␈↓ ↓⊗ [(NULL (CDR PAT))
␈↓ εK ('MATCH VAR
␈↓ ↓⊗ ('AND ('MATCHBIND VAR (LIST (CDDR (CAR PAT)))
␈↓ εK (RPLACA
␈↓ ↓⊗ T NIL)
␈↓ εK PAT
␈↓ ↓⊗ ('REPLACE←SIDE←EFFECT
␈↓ εK (CONS (CADAR PAT)
␈↓ ↓⊗ VAR
␈↓ εK (CONS (CADDAR PAT)
␈↓ ↓⊗ (CADR (CAR PAT]
␈↓ εK (CONS (QUOTE !)
␈↓ ↓⊗ [[OR (ARB? (CDDAR PAT))
␈↓ εK (CDDDAR PAT]
␈↓ ↓⊗ (NOT (ELT? (CDDAR PAT]
␈↓ εK (T (HELP (QUOTE "CANT DO THIS ! YET")
␈↓ ↓⊗
␈↓ εK PAT]
␈↓ ↓⊗ (* To match var against (seg←x ...), match against
␈↓ εK [!-> (* (... !←EXPR ...))
␈↓ ↓⊗ (seg !tem← ...), and then replace var with
␈↓ εK ('AND ('MATCHBIND VAR (CDR PAT)
␈↓ ↓⊗ (NCONC/APPEND x tem))
␈↓ εK T NIL)
␈↓ ↓⊗
␈↓ εK ('REPLACE←SIDE←EFFECT
␈↓ ↓⊗
␈↓ εK VAR
␈↓ ↓⊗ ('AND ('MATCHBIND
␈↓ εK (CDAR PAT]
␈↓ ↓⊗ VAR
␈↓ εK [!← (* (... !VAR← ...))
␈↓ ↓⊗ (CONS (CDDAR PAT)
␈↓ εK (COND
␈↓ ↓⊗ (CONS (CONS (QUOTE !←)
␈↓ εK [(LOCALPATVAR (CDAR PAT))
␈↓ ↓⊗ (SETQ TEM (MAKEVAR
␈↓ εK ('AND ['SETQ (CDAR PAT)
␈↓ ↓⊗ T)))
␈↓ εK VAR
␈↓ ↓⊗ (CDR PAT)))
␈↓ εK (AND ORSETQFLG (CANMATCHNIL
␈↓ ↓⊗ T NIL)
␈↓ εK (CDR PAT]
␈↓ ↓⊗ ('REPLACE←SIDE←EFFECT
␈↓ εK ('MATCH (CDAR PAT)
␈↓ ↓⊗ ('LDIFF (COPY VAR)
␈↓ εK (CDR PAT]
␈↓ ↓⊗ TEM)
␈↓ εK (T ('AND ('MATCH VAR (CDR PAT))
␈↓ ↓⊗ (CADAR PAT]
␈↓ εK ('SETQ←SIDE←EFFECT
␈↓ ↓⊗ (T (HELP "CAN'T DO THIS REPLACE YET" PAT]
␈↓ εK (CDAR PAT)
␈↓ ↓⊗ (ANY (* Segment any's go
␈↓ εK VAR
␈↓ ↓⊗ here)
␈↓ εK (AND ORSETQFLG (CANMATCHNIL
␈↓ ↓⊗ (HELP (QUOTE "CAN'T DO AN ANY WHEN ")
␈↓ εK (CDR PAT]
␈↓ ↓⊗ (QUOTE "SOME ARE SEGMENTS")))
␈↓ εK (($$ ' = == DEFAULT)
␈↓ ↓⊗ [!
␈↓ εK (HELP
␈↓ ↓⊗ (COND
␈↓ εK "SHOULDN'T GET HERE - THESE PATS HANDLED PREVIOUSLY" PAT)
␈↓ ↓⊗ ((NULL (CDR PAT))
␈↓ εK )
␈↓ ↓⊗
␈↓ εK (HELP (QUOTE "I DONT UNDERSTAND THIS PATTERN:")
␈↓ ↓⊗ (* To MATCH VAR against (!pat) is the same as
␈↓ εK PAT)))
␈↓ ↓⊗ matching it against PAT)
␈↓ εK (T (HELP (QUOTE "WHAT'S HERE")
␈↓ ↓⊗
␈↓ εK PAT])
␈↓ ↓⊗
␈↓ εK
␈↓ ↓⊗␈↓α('MATCHBIND␈↓↓
␈↓ εK (COND
␈↓ ↓⊗ [LAMBDA (VAR PAT MUSTBEMATCH)
␈↓ εK ((NOT (EVERY PAT (FUNCTION CANMATCHNIL)))
␈↓ ↓⊗ ('MATCH VAR PAT])
␈↓ εK ('MATCHEXP VAR PAT))
␈↓ ↓⊗
␈↓ εK (T ('MATCHEXP1 VAR PAT (FUNCTION 'MATCHNNIL])
␈↓ ↓⊗␈↓α('MATCHELT␈↓↓
␈↓ εK
␈↓ ↓⊗ [LAMBDA (VAR PATELT MUSTBEMATCH)
␈↓ εK␈↓α('MATCHSUBPAT␈↓↓
␈↓ ↓⊗
␈↓ εK [LAMBDA (VAR PATELT)
␈↓ ↓⊗ (* This function matches VAR against PATELT when
␈↓ εK (PROG ((NULLCHK T))
␈↓ ↓⊗ PATELT is an "ELEMENT" pattern -
␈↓ εK (COND
␈↓ ↓⊗ MUSTBEMATCH has same meaning as in MAKEMATCH)
␈↓ εK (LISTPCHK ('AND ('LISTP VAR)
␈↓ ↓⊗
␈↓ εK ('MATCH VAR PATELT)))
␈↓ ↓⊗
␈↓ εK (T ('MATCH VAR PATELT])
␈↓ ↓⊗ (COND
␈↓ εK
␈↓ ↓⊗ ((NLISTP PATELT)
␈↓ εK␈↓α('MATCHTAIL␈↓↓
␈↓ ↓⊗ (SELECTQ PATELT
␈↓ εK [LAMBDA (VAR PAT MUSTRETURNTAIL)
␈↓ ↓⊗ (* ('RETURN VAR))
␈↓ εK
␈↓ ↓⊗ (($1 & ≠1)
␈↓ εK (* MUSTRETURNTAIL is on if the expression must be
␈↓ ↓⊗ T)
␈↓ εK the tail that matched -
␈↓ ↓⊗ (HELP (QUOTE "BAD PATTERN ELEMENT")
␈↓ εK If it is T then just return EXPRESSION;
␈↓ ↓⊗ PATELT)))
␈↓ εK otherwise, it is a variable which must be set to the
␈↓ ↓⊗ ((NLISTP (CAR PATELT))
␈↓ εK EXPRESSION)
␈↓ ↓⊗ (SELECTQ (CAR PATELT)
␈↓ εK
␈↓ ↓⊗ (DEFAULT (HELP (QUOTE
␈↓ εK
␈↓ ↓⊗ "DEFAULT SHOULD HAVE BEEN HANDLED IN ANALPAT")
␈↓ εK (PROG (MATCH SETS TEM TEM1 TAIL (LEN 0))
␈↓ ↓⊗ (QUOTE "RETURN NIL TO DO IT NOW"))
␈↓ εK (COND
␈↓ ↓⊗ (MAKEDEFAULT PATELT)
␈↓ εK [(EQ (CAAR PAT)
␈↓ ↓⊗ ('MATCHELT VAR PATELT MUSTBEMATCH))
␈↓ εK (QUOTE !←))
␈↓ ↓⊗ (==('EQ VAR (CDR PATELT)))
␈↓ εK ('SETVAR MUSTRETURNTAIL ('MATCHTAIL VAR (CDR PAT)
␈↓ ↓⊗ ['('EQUAL VAR (KWOTE (CDR PATELT]
␈↓ εK (CDAR PAT))
␈↓ ↓⊗ (=('EQUAL VAR (CDR PATELT)))
␈↓ εK (AND ORSETQFLG (CANMATCHNIL (CDR PAT]
␈↓ ↓⊗ [:(COND
␈↓ εK ((EQ (CAAR PAT)
␈↓ ↓⊗ ((OR (NLISTP (CDR PATELT))
␈↓ εK (QUOTE !->))
␈↓ ↓⊗ (EQ (CADR PATELT)
␈↓ εK (COND
␈↓ ↓⊗ (QUOTE LAMBDA)))
␈↓ εK ([NOT (FMEMB MUSTRETURNTAIL (QUOTE (NIL T]
␈↓ ↓⊗ (LIST (CDR PATELT)
␈↓ εK (HELP)))
␈↓ ↓⊗ VAR))
␈↓ εK ('REPLACE←SIDE←EFFECT
␈↓ ↓⊗ (T (SUBST VAR (QUOTE @)
␈↓ εK ('MATCHTAIL VAR (CDR PAT)
␈↓ ↓⊗ (PROG (@)
␈↓ εK T)
␈↓ ↓⊗ (DWIMIFY (CDR PATELT]
␈↓ εK (CDAR PAT)))
␈↓ ↓⊗ [ANY ('OR (MAPCAR (CDR PATELT)
␈↓ εK [(NULL (SETQ TAIL (SKIP$I PAT)))
␈↓ ↓⊗ (FUNCTION (LAMBDA (PE1)
␈↓ εK (COND
␈↓ ↓⊗ ('MATCHELT VAR PE1 T]
␈↓ εK ((NULL MUSTRETURNTAIL)
␈↓ ↓⊗ [←('AND ('MATCHELT VAR (CDDπ PATELT)
␈↓ εK ('NOTLESSPLENGTH VAR LEN))
␈↓ ↓⊗ T)
␈↓ εK (T ('SETVAR MUSTRETURNTAIL ('NLEFT VAR LEN)
␈↓ ↓⊗ ('SETQ←SIDE←EFFECT
␈↓ εK ORSETQFLG]
␈↓ ↓⊗ (CADR PATELT)
␈↓ εK [(AND (NOT (EQ PAT TAIL))
␈↓ ↓⊗ VAR
␈↓ εK (COND
␈↓ ↓⊗ (AND ORSETQFLG (CANMATCHNIL (CDDR PATELT]
␈↓ εK ((NULL MUSTRETURNTAIL)
␈↓ ↓⊗ [-> ('AND ('MATCHELT VAR (CDDR PATELT)
␈↓ εK ('MATCHTAIL ('NTH VAR ('PLUS 1 LEN))
␈↓ ↓⊗ T)
␈↓ εK TAIL))
␈↓ ↓⊗ ('REPLACE←SIDE←EFFECT
␈↓ εK ((NULLPAT? TAIL)
␈↓ ↓⊗ VAR
␈↓ εK ('SETVAR MUSTRETURNTAIL ('NLEFT VAR LEN NIL]
␈↓ ↓⊗ (CADR PATELT]
␈↓ εK ((AND (EQ (CAAR PAT)
␈↓ ↓⊗ ('MATCHSUBPAT VAR PATELT)))
␈↓ εK (QUOTE !))
␈↓ ↓⊗ (T ('MATCHSUBPAT VAR PATELT])
␈↓ εK (EQ (CADAR PAT)
␈↓ ↓⊗
␈↓ εK (QUOTE ==))
␈↓ ↓⊗␈↓α('MATCHEXP␈↓↓
␈↓ εK (NOT (CDR PAT)))
␈↓ ↓⊗ [LAMBDA (VAR PAT)
␈↓ εK ('SETVAR MUSTRETURNTAIL ('TAILP (CDDAR PAT)
␈↓ ↓⊗
␈↓ εK VAR)))
␈↓ ↓⊗ (* CALL THIS FUNCTION INSTEAD OF 'MATCH IF THE VAR
␈↓ εK ((NULL (SETQ TAIL (SKIP$ANY PAT)))
␈↓ ↓⊗ MIGHT NOT BE EASY TO RECOMPUTE)
␈↓ εK (* PAT is $ followed by
␈↓ ↓⊗
␈↓ εK a bunch of fixed-length
␈↓ ↓⊗
␈↓ εK items)
␈↓ ↓⊗ ('MATCHEXP1 VAR PAT (FUNCTION 'MATCH])
␈↓ εK ('MATCH&SET ('NLEFT VAR LEN)
␈↓ ↓⊗
␈↓ εK PAT
␈↓ ↓⊗␈↓α('MATCHFIXED␈↓↓
␈↓ εK (FUNCTION 'MATCHFIXED)
␈↓ ↓⊗ [LAMBDA (VAR PAT)
␈↓ εK NIL MUSTRETURNTAIL))
␈↓ ↓⊗
␈↓ εK (($? (CAR PAT)) (* Can we just ignore it
␈↓ ↓⊗ (* This function is called when it is known that if
␈↓ εK -
␈↓ ↓⊗ any element of VAR is non NIL, then VAR is of the
␈↓ εK I.e. $ $)
␈↓ ↓⊗ right length to MATCH PAT and so no length tests
␈↓ εK ('MATCHTAIL VAR (CDR PAT)
␈↓ ↓⊗ need be performed)
␈↓ εK MUSTRETURNTAIL))
␈↓ ↓⊗
␈↓ εK (('MATCHWITHMEMB VAR PAT MUSTRETURNTAIL))
␈↓ ↓⊗
␈↓ εK ((AND (NOT (NULLPAT? TAIL))
␈↓ ↓⊗ (PROG (NULLCHK)
␈↓ εK (NOT (EQ PAT TAIL))
␈↓ ↓⊗ (NOMATCHARB? (CAR TAIL)))
␈↓ εK (COND
␈↓ ↓⊗ ('MATCH&SET ('MATCHSOME VAR
␈↓ εK (CDRFN (BLKAPPLY* CDRFN
␈↓ ↓⊗ (PROGN (RPLACD (NLEFT PAT 1 TAIL)
␈↓ εK TEM))
␈↓ ↓⊗ (QUOTE ($)))
␈↓ εK (T TEM))
␈↓ ↓⊗ PAT))
␈↓ εK PAT)
␈↓ ↓⊗ TAIL
␈↓ εK TEM)))
␈↓ ↓⊗ (FUNCTION 'MATCHEXP)
␈↓ εK ((LOCALPATVAR (SETQ TEM (MAKEVAR VARTOSET)))
␈↓ ↓⊗ (FUNCTION 'CDRLEN)
␈↓ εK ('AND ('SETQ TEM EXPR)
␈↓ ↓⊗ MUSTRETURNTAIL))
␈↓ εK (BLKAPPLY* MATCHFN (COND
␈↓ ↓⊗ (T ('SETVAR MUSTRETURNTAIL ('MATCHSOME VAR PAT)
␈↓ εK (CDRFN (BLKAPPLY* CDRFN TEM))
␈↓ ↓⊗ ORSETQFLG])
␈↓ εK (T TEM))
␈↓ ↓⊗
␈↓ εK PAT)))
␈↓ ↓⊗␈↓α('MATCHSOME␈↓↓
␈↓ εK (T [POSTPONE ('SETQ TEM (SETQ TEM (MAKEVAR T]
␈↓ ↓⊗ [LAMBDA (VAR PAT)
␈↓ εK ('AND ('SETQ TEM EXPR)
␈↓ ↓⊗ (PROG ((SOMEVARS (CONS (GENSYML VAR)
␈↓ εK ('AND (BLKAPPLY* MATCHFN
␈↓ ↓⊗ (CONS (GENSYML VAR)
␈↓ εK (COND
␈↓ ↓⊗ NIL)))
␈↓ εK (CDRFN (BLKAPPLY* CDRFN
␈↓ ↓⊗ (MUSTBEMATCH T))
␈↓ εK TEM))
␈↓ ↓⊗ ('SOME VAR (LIST (CAR SOMEVARS)
␈↓ εK (T TEM))
␈↓ ↓⊗ (CADR SOMEVARS))
␈↓ εK PAT)
␈↓ ↓⊗ (DSUBST (CAR SOMEVARS)
␈↓ εK TEM]
␈↓ ↓⊗ ('CAR (CADR SOMEVARS))
␈↓ εK (T (BLKAPPLY* MATCHFN (COND
␈↓ ↓⊗ ('MATCH (CADR SOMEVARS)
␈↓ εK (CDRFN (BLKAPPLY* CDRFN EXPR))
␈↓ ↓⊗ PAT])
␈↓ εK (T EXPR))
␈↓ ↓⊗
␈↓ εK PAT])
␈↓ ↓⊗␈↓α('MATCHWITHMEMB␈↓↓
␈↓ εK
␈↓ ↓⊗ [LAMBDA (VAR PAT MUSTRETURNTAIL)
␈↓ εK␈↓α('CDRLEN␈↓↓
␈↓ ↓⊗ (AND (MEMBPAT? PAT)
␈↓ εK [LAMBDA (EXPR)
␈↓ ↓⊗ ('MATCH&SET (EQTOMEMB ('MATCHELT VAR (CAR PAT)))
␈↓ εK ('NTH EXPR ('PLUS 1 LEN])
␈↓ ↓⊗ (RPLACA PAT (QUOTE $1))
␈↓ εK
␈↓ ↓⊗ (FUNCTION 'MATCHEXP)
␈↓ εK␈↓α(POSTPONE␈↓↓
␈↓ ↓⊗ NIL MUSTRETURNTAIL])
␈↓ εK [LAMBDA (EFFECT)
␈↓ ↓⊗
␈↓ εK (SETQ POSTPONEDEFFECTS (NCONC1 POSTPONEDEFFECTS EFFECT))
␈↓ ↓⊗␈↓α('MATCHNNIL␈↓↓
␈↓ εK T])
␈↓ ↓⊗ [LAMBDA (VAR PAT)
␈↓ εK
␈↓ ↓⊗ ('AND VAR ('MATCH VAR PAT])
␈↓ εK␈↓α('HEADP␈↓↓
␈↓ ↓⊗
␈↓ εK [LAMBDA (A B)
␈↓ ↓⊗␈↓α('MATCHEXP1␈↓↓
␈↓ εK (LIST (QUOTE HEADP)
␈↓ ↓⊗ [LAMBDA (VAR PAT FN)
␈↓ εK A B])
␈↓ ↓⊗ (COND
␈↓ εK
␈↓ ↓⊗ ((EASYTORECOMPUTE VAR)
␈↓ εK␈↓α(ABP␈↓↓
␈↓ ↓⊗ (BLKAPPLY* FN VAR PAT))
␈↓ εK [LAMBDA (PATELT SEGEXPR)
␈↓ ↓⊗ (T (PROG (EXPR (FUNNYTEM (GENSYML VAR)))
␈↓ εK (COND
␈↓ ↓⊗ (SETQ EXPR (BLKAPPLY* FN FUNNYTEM PAT))
␈↓ εK [(NLISTP (CDR PATELT))
␈↓ ↓⊗ (COND
␈↓ εK (SELECTQ (CDR PATELT)
␈↓ ↓⊗ ((OR (NULL EXPR)
␈↓ εK (("*" *) (* !* is like result←$)
␈↓ ↓⊗ (EQ EXPR T))
␈↓ εK (SETQ SETS T)
␈↓ ↓⊗ (SETQ EXPR FUNNYTEM)))
␈↓ εK (QUOTE ARB))
␈↓ ↓⊗ (SETQ EXPR (MAKESUBST FUNNYTEM VAR
␈↓ εK (($1 &) (* !$1 is the same as $)
␈↓ ↓⊗ (LIST EXPR POSTPONEDEFFECTS
␈↓ εK (QUOTE ARB))
␈↓ ↓⊗ MUSTRETURN)))
␈↓ εK (HELP (QUOTE "FUNNY NLISTP PAT AFTER ! IN")
␈↓ ↓⊗ (SETQ POSTPONEDEFFECTS (CADR EXPR))
␈↓ εK (CDR PATELT]
␈↓ ↓⊗ (SETQ MUSTRETURN (CADDR EXPR))
␈↓ εK (T (SELECTQ (CAR (CDR PATELT))
␈↓ ↓⊗ (RETURN (CAR EXPR])
␈↓ εK [' (* !'exp matches exactly
␈↓ ↓⊗
␈↓ εK length exp things)
␈↓ ↓⊗␈↓α(LOCALPATVAR␈↓↓
␈↓ εK (LENGTH (CDR (CDR PATELT]
␈↓ ↓⊗ [LAMBDA (VAR)
␈↓ εK ((= ==) (* = exp matches
␈↓ ↓⊗ (PROG ((LST BINDINGS))
␈↓ εK precomputable NUMBER of
␈↓ ↓⊗ LP (COND
␈↓ εK things)
␈↓ ↓⊗ ((NULL LST)
␈↓ εK (SETQ MATCH T)
␈↓ ↓⊗ (RETURN NIL))
␈↓ εK
␈↓ ↓⊗ ((OR (EQ VAR (CAR LST))
␈↓ εK (* THIS ISWHAT USED TO BE HERE:
␈↓ ↓⊗ (EQ VAR (CAAR LST)))
␈↓ εK (COND (SEGEXPR ('LENGTH (CDR
␈↓ ↓⊗ (RETURN T)))
␈↓ εK (CDR PATELT)))) (T (QUOTE SEG))))
␈↓ ↓⊗ (SETQ LST (CDR LST))
␈↓ εK
␈↓ ↓⊗ (GO LP])
␈↓ εK
␈↓ ↓⊗
␈↓ εK (QUOTE ARB))
␈↓ ↓⊗␈↓α('MATCH&SET␈↓↓
␈↓ εK (:(SETQ MATCH T)
␈↓ ↓⊗ [LAMBDA (EXPR PAT MATCHFN CDRFN VARTOSET)
␈↓ εK (QUOTE ARB))
␈↓ ↓⊗ (COND
␈↓ εK ((← ->)
␈↓ ↓⊗ [VARTOSET (COND
␈↓ εK (SETQ SETS T)
␈↓ ↓⊗ ((EQ T VARTOSET)
␈↓ εK (ABP (CDR (CDR PATELT))
␈↓ ↓⊗ ('AND ('SETQ (SETQ TEM (MAKEVAR T))
␈↓ εK SEGEXPR))
␈↓ ↓⊗ EXPR)
␈↓ εK (DEFAULT (* MAKEDEFAULT actually
␈↓ ↓⊗ ('AND (BLKAPPLY* MATCHFN
␈↓ εK smashes it, so go ahead
␈↓ ↓⊗ & try it again)
␈↓ εK (OR (NUMBERP (CDR PATELT))
␈↓ ↓⊗ (MAKEDEFAULT (CDR PATELT))
␈↓ εK (AND SEGEXPR (CDR PATELT))
␈↓ ↓⊗ (ABP PATELT SEGEXPR))
␈↓ εK (QUOTE SEG)))
␈↓ ↓⊗ (ANY
␈↓ εK (DEFAULT (ANALPATELT (MAKEDEFAULT PATELT)
␈↓ ↓⊗
␈↓ εK SEGEXPR))
␈↓ ↓⊗ (* ! (any ...) matches the MAX of ANAL!PAT of the
␈↓ εK [(= == ' :)
␈↓ ↓⊗ elts of the any)
␈↓ εK (SETQ MATCH T) (* = FOO matches an
␈↓ ↓⊗
␈↓ εK element)
␈↓ ↓⊗
␈↓ εK (COND
␈↓ ↓⊗ (ANALPAT (CDR (CDR PATELT))
␈↓ εK (SEGEXPR 1)
␈↓ ↓⊗ (AND SEGEXPR (QUOTE SEGEXPR))
␈↓ εK (T (QUOTE ELT]
␈↓ ↓⊗ (FUNCTION ANAL!PAT)))
␈↓ εK [ANY (* It's the MAX of them
␈↓ ↓⊗ (COND
␈↓ εK all)
␈↓ ↓⊗ [(NOT (CDDR PATELT))
␈↓ εK (ANALPAT (CDR PATELT)
␈↓ ↓⊗ (COND
␈↓ εK (AND SEGEXPR (QUOTE SEGEXPR]
␈↓ ↓⊗ ((LISTP (CADR PATELT))
␈↓ εK (← (* It's a set, with the
␈↓ ↓⊗ (RPLNODE PATELT (CADR PATELT))
␈↓ εK same PROP as what's
␈↓ ↓⊗ (ANALPATELT PATELT SEGEXPR))
␈↓ εK being set)
␈↓ ↓⊗ (T (ANALPATELT (CADR PATELT)
␈↓ εK (SETQ SETS T)
␈↓ ↓⊗ SEGEXPR]
␈↓ εK (ANALPATELT (CDDR PATELT)
␈↓ ↓⊗ (T (ANALPAT (CDR PATELT])
␈↓ εK SEGEXPR))
␈↓ ↓⊗
␈↓ εK (-> (* Ditto)
␈↓ ↓⊗␈↓α(RPLNODE␈↓↓
␈↓ εK (SETQ SETS T)
␈↓ ↓⊗ [LAMBDA (X Y)
␈↓ εK (ANALPATELT (CDDR PATELT)
␈↓ ↓⊗ (RPLACA (RPLACD X (CDR Y))
␈↓ εK SEGEXPR))
␈↓ ↓⊗ (CAR Y])
␈↓ εK ((!← !->)
␈↓ ↓⊗)
␈↓ εK (SETQ SETS T)
␈↓ ↓⊗␈↓α(DEFINEQ␈↓↓
␈↓ εK 0)
␈↓ ↓⊗
␈↓ εK (PROGN (* Got a PATELT which is
␈↓ ↓⊗␈↓α(ANALPATELT␈↓↓
␈↓ εK a list of pats)
␈↓ ↓⊗ [LAMBDA (PATELT SEGEXPR)
␈↓ εK (ANALPAT PATELT)
␈↓ ↓⊗
␈↓ εK (COND
␈↓ ↓⊗ (* Analyze PATELT , returning either -
␈↓ εK (SEGEXPR 1)
␈↓ ↓⊗ "ELT" if PATELT matches a single element -
␈↓ εK (T (QUOTE ELT])
␈↓ ↓⊗ "SEG" if PATELT matches a segment of fixed but not
␈↓ εK
␈↓ ↓⊗ given size -
␈↓ εK␈↓α(ANALPAT␈↓↓
␈↓ ↓⊗ A number if PATELT matches a segment of fixed, given
␈↓ εK [LAMBDA (PAT FLG FN TAIL)
␈↓ ↓⊗ size -
␈↓ εK
␈↓ ↓⊗ Or "ARB" if PATELT matches a segment of not
␈↓ εK (* Calls either ANALPATELT or FN on the elements of
␈↓ ↓⊗ precomputable size)
␈↓ εK PAT (up to TAIL) and returns the MAXANAL of them -
␈↓ ↓⊗
␈↓ εK The value of FLG determinses whether MAXANAL returns
␈↓ ↓⊗
␈↓ εK a sum or a maximum)
␈↓ ↓⊗
␈↓ εK
␈↓ ↓⊗ (* Unless SEGEXPR is on, in which case, the size of
␈↓ εK
␈↓ ↓⊗ the expr is returned instead of seg)
␈↓ εK (PROG (VAL)
␈↓ ↓⊗
␈↓ εK LP (COND
␈↓ ↓⊗
␈↓ εK ((OR (EQ PAT TAIL)
␈↓ ↓⊗
␈↓ εK (NOT PAT))
␈↓ ↓⊗ (* Also, if the PATELT is a "SET", sets special
␈↓ εK (RETURN VAL)))
␈↓ ↓⊗ variable "SETS" -
␈↓ εK (SETQ VAL (MAXANAL (BLKAPPLY (OR FN (QUOTE ANALPATELT))
␈↓ ↓⊗ If it contains a match (i.e., other than $i's or $'s
␈↓ εK (LIST (CAR PAT)))
␈↓ ↓⊗ or sets involving those) it sets the special
␈↓ εK VAL FLG))
␈↓ ↓⊗ variable "MATCH")
␈↓ εK (SETQ PAT (CDR PAT))
␈↓ ↓⊗
␈↓ εK (GO LP])
␈↓ ↓⊗
␈↓ εK
␈↓ ↓⊗ (COND
␈↓ εK␈↓α(MAXANAL␈↓↓
␈↓ ↓⊗ ((NLISTP PATELT)
␈↓ εK [LAMBDA (VAL1 VAL2 FLG)
␈↓ ↓⊗ (SELECTQ PATELT
␈↓ εK (COND
␈↓ ↓⊗ [($1 &)
␈↓ εK ((NOT VAL1)
␈↓ ↓⊗ (COND
␈↓ εK VAL2)
␈↓ ↓⊗ (SEGEXPR 1)
␈↓ εK ((NOT VAL2)
␈↓ ↓⊗ (T (QUOTE ELT]
␈↓ εK VAL1)
␈↓ ↓⊗ [("*" *)
␈↓ εK ((OR (EQ VAL2 (QUOTE ARB))
␈↓ ↓⊗ (SETQ SETS T)
␈↓ εK (EQ VAL1 (QUOTE ARB)))
␈↓ ↓⊗ (COND
␈↓ εK (QUOTE ARB))
␈↓ ↓⊗ (SEGEXPR 1)
␈↓ εK ((OR (EQ VAL1 (QUOTE SEG))
␈↓ ↓⊗ (T (QUOTE ELT]
␈↓ εK (EQ VAL2 (QUOTE SEG)))
␈↓ ↓⊗ (($ --)
␈↓ εK (QUOTE SEG))
␈↓ ↓⊗ (QUOTE ARB))
␈↓ εK ((EQ FLG (QUOTE SEGEXPR))
␈↓ ↓⊗ (HELP (QUOTE "FUNNY PAT IN ANALPATELT")
␈↓ εK ('PLUS VAL1 VAL2))
␈↓ ↓⊗ PATELT)))
␈↓ εK (FLG (IPLUS (OR (NUMBERP VAL1)
␈↓ ↓⊗ (T (SELECTQ (CAR PATELT)
␈↓ εK 1)
␈↓ ↓⊗ (! (ABP PATELT SEGEXPR))
␈↓ εK (OR (NUMBERP VAL2)
␈↓ ↓⊗ ($$ (* Either $$ NUMBER or
␈↓ εK 1)))
␈↓ ↓⊗ $$ EXPRESSION)
␈↓ εK [(EQ VAL1 (QUOTE ELT))
␈↓ ↓⊗ (COND
␈↓ εK (FMEMB (CDR PATELT)
␈↓ ↓⊗ ((OR (EQ VAL2 1)
␈↓ εK (QUOTE (& $1 ≠1])
␈↓ ↓⊗ (EQ VAL2 (QUOTE ELT)))
␈↓ εK
␈↓ ↓⊗ VAL2)
␈↓ εK␈↓α(SKIP$I␈↓↓
␈↓ ↓⊗ (T (QUOTE SEG]
␈↓ εK [LAMBDA (PAT)
␈↓ ↓⊗ [(EQ VAL2 (QUOTE ELT))
␈↓ εK
␈↓ ↓⊗ (COND
␈↓ εK (* Returns to the first TAIL of PAT which doesn't
␈↓ ↓⊗ ((EQ VAL1 1)
␈↓ εK begin with a $i or a $$foo -
␈↓ ↓⊗ VAL1)
␈↓ εK Sets the variable "LEN" to the total length of
␈↓ ↓⊗ (T (QUOTE SEG]
␈↓ εK things skipped over)
␈↓ ↓⊗ (T (QUOTE SEG])
␈↓ εK
␈↓ ↓⊗
␈↓ εK
␈↓ ↓⊗␈↓α(ANAL!PAT␈↓↓
␈↓ εK (SOME PAT (FUNCTION (LAMBDA (ELT)
␈↓ ↓⊗ [LAMBDA (PAT SEGEXPR)
␈↓ εK (COND
␈↓ ↓⊗ (COND
␈↓ εK ((FMEMB ELT (QUOTE (& $1 ≠1)))
␈↓ ↓⊗ ((NLISTP PAT)
␈↓ εK (SETQ LEN ('PLUS 1 LEN))
␈↓ ↓⊗ (SELECTQ PAT
␈↓ εK NIL)
␈↓ ↓⊗ (("*" *) (* !* is like result←$)
␈↓ εK ((EQ (CAR ELT)
␈↓ ↓⊗ (SETQ SETS T)
␈↓ εK (QUOTE $$))
␈↓ ↓⊗ (QUOTE ARB))
␈↓ εK (SETQ LEN ('PLUS LEN (CDR ELT)))
␈↓ ↓⊗ (($1 &) (* !$1 is the same as $)
␈↓ εK NIL)
␈↓ ↓⊗ (QUOTE ARB))
␈↓ εK (T])
␈↓ ↓⊗ (HELP (QUOTE "FUNNY NLISTP PAT AFTER ! IN")
␈↓ εK
␈↓ ↓⊗ PAT)))
␈↓ εK␈↓α(SKIP$␈↓↓
␈↓ ↓⊗ (T (SELECTQ (CAR PAT)
␈↓ εK [LAMBDA (PAT SETOK MATCHOK TAIL)
␈↓ ↓⊗ (' (* !'exp matches exactly
␈↓ εK
␈↓ ↓⊗ length exp things)
␈↓ εK (* SCANS PAT UNTIL ONE OF THE FOLLOWING CONDITIONS
␈↓ ↓⊗ (LENGTH (CDR PAT)))
␈↓ εK OCCURS: -
␈↓ ↓⊗ ((= ==) (* = exp matches
␈↓ εK (1) TAIL IS HIT -
␈↓ ↓⊗ precomputable NUMBER of
␈↓ εK (2) A PATTERN ELEMENT WHICH MATCHES AN ARBITRARY
␈↓ ↓⊗ things)
␈↓ εK LENGTH SEGMENT IS HIT -
␈↓ ↓⊗ (SETQ MATCH T)
␈↓ εK (3) SETOK IS NIL AND A PATTERN ELMENT INVOLVING A ←
␈↓ ↓⊗
␈↓ εK IS HIT -
␈↓ ↓⊗ (* THIS ISWHAT USED TO BE HERE:
␈↓ εK (4) MATCHOK IS NIL AND A PATTERN ELMENT INVOLVING A
␈↓ ↓⊗ (COND (SEGEXPR ('LENGTH (CDR PAT)))
␈↓ εK "MATCH" OF ANYKIND IS HIT -
␈↓ ↓⊗ (T (QUOTE SEG))))
␈↓ εK (5) THE END OF PAT IS REACHED)
␈↓ ↓⊗
␈↓ εK
␈↓ ↓⊗
␈↓ εK
␈↓ ↓⊗ (QUOTE ARB))
␈↓ εK
␈↓ ↓⊗ (:(SETQ MATCH T)
␈↓ εK (* The free variables SETS and MATCH are set to T if
␈↓ ↓⊗ (QUOTE ARB))
␈↓ εK a set or MATCH (respectively) are found in any of
␈↓ ↓⊗ ((← ->)
␈↓ εK the pattern elements passed over)
␈↓ ↓⊗ (SETQ SETS T)
␈↓ εK
␈↓ ↓⊗ (ANAL!PAT (CDDR PAT)))
␈↓ εK
␈↓ ↓⊗ (DEFAULT (* MAKEDEFAULT actually
␈↓ εK (PROG (OLDSET OLDMATCH)
␈↓ ↓⊗ smashes it, so go ahead
␈↓ εK LP (SETQ OLDSET SETS)
␈↓ ↓⊗ & try it again)
␈↓ εK (SETQ OLDMATCH MATCH)
␈↓ ↓⊗ (MAKEDEFAULT PAT)
␈↓ εK [COND
␈↓ ↓⊗ (ANAL!PAT PAT SEGEXPR))
␈↓ εK ((OR (NULL PAT)
␈↓ ↓⊗ (ANY
␈↓ εK (EQ PAT TAIL))
␈↓ ↓⊗
␈↓ εK (RETURN PAT))
␈↓ ↓⊗ (* ! (any ...) matches the MAX of ANAL!PAT of the
␈↓ εK ((OR (EQ (SETQ TEM (ANALPATELT (CAR PAT)
␈↓ ↓⊗ elts of the any)
␈↓ εK T))
␈↓ ↓⊗
␈↓ εK (QUOTE ARB))
␈↓ ↓⊗
␈↓ εK (AND (NOT SETOK)
␈↓ ↓⊗ (ANALPAT (CDR PAT)
␈↓ εK SETS)
␈↓ ↓⊗ (AND SEGEXPR (QUOTE SEGEXPR))
␈↓ εK (AND (NOT MATCHOK)
␈↓ ↓⊗ (FUNCTION ANAL!PAT)))
␈↓ εK MATCH))
␈↓ ↓⊗ (PROGN
␈↓ εK (SETQ SETS OLDSET)
␈↓ ↓⊗
␈↓ εK (SETQ MATCH OLDMATCH)
␈↓ ↓⊗ (* Otherwise, there is a !
␈↓ εK (RETURN PAT))
␈↓ ↓⊗ (PAT) so it's the MAX, except if there are all fixed
␈↓ εK (T (SETQ LEN ('PLUS TEM LEN]
␈↓ ↓⊗ segs, add'em up)
␈↓ εK (SETQ PAT (CDR PAT))
␈↓ ↓⊗
␈↓ εK (GO LP])
␈↓ ↓⊗
␈↓ εK
␈↓ ↓⊗ (ANALPAT PAT (COND
␈↓ εK␈↓α(SKIP$ANY␈↓↓
␈↓ ↓⊗ (SEGEXPR (QUOTE SEGEXPR))
␈↓ εK [LAMBDA (PAT)
␈↓ ↓⊗ (T T))
␈↓ εK
␈↓ ↓⊗ NIL NIL)
␈↓ εK (* Scans PAT until a pattern element which matches
␈↓ ↓⊗ (QUOTE ARB])
␈↓ εK an arbitrary length segment is hit)
␈↓ ↓⊗
␈↓ εK
␈↓ ↓⊗␈↓α($?␈↓↓
␈↓ εK
␈↓ ↓⊗ [LAMBDA (PATELT)
␈↓ εK
␈↓ ↓⊗ (OR (FMEMB PATELT (QUOTE ($ ≠ --)))
␈↓ εK (* The free variables SETS and MATCH are set to T if
␈↓ ↓⊗ (AND (EQ (CAR PATELT (QUOTE !))
␈↓ εK a set or MATCH (respectively) are found in any of
␈↓ ↓⊗ the pattern elements passed over)
␈↓ εK ($? PATELT))
␈↓ ↓⊗
␈↓ εK (T (SELECTQ (CAR PATELT)
␈↓ ↓⊗
␈↓ εK (! (NOMATCHELT? (CDR PATELT)))
␈↓ ↓⊗ (PROG (OLDSET OLDMATCH TEM)
␈↓ εK (DEFAULT (NOMATCHARB? (MAKEDEFAULT PATELT)))
␈↓ ↓⊗ LP (SETQ OLDSET SETS)
␈↓ εK ((-> ←)
␈↓ ↓⊗ (SETQ OLDMATCH MATCH)
␈↓ εK (NOMATCHARB? (CDDR PATELT)))
␈↓ ↓⊗ [COND
␈↓ εK ((!← !->)
␈↓ ↓⊗ ((NULL PAT)
␈↓ εK (HELP "NOMATCHARB? SHOULDNT BE GIVEN" PATELT))
␈↓ ↓⊗ (RETURN PAT))
␈↓ εK NIL])
␈↓ ↓⊗ ((EQ (SETQ TEM (ANALPATELT (CAR PAT)
␈↓ εK
␈↓ ↓⊗ T))
␈↓ εK␈↓α(NOMATCHELT?␈↓↓
␈↓ ↓⊗ (QUOTE ARB))
␈↓ εK [LAMBDA (PAT)
␈↓ ↓⊗ (SETQ SETS OLDSET)
␈↓ εK (PROG (MATCH SETS)
␈↓ ↓⊗ (SETQ MATCH OLDMATCH)
␈↓ εK (AND (EQ (ANAL!PAT PAT)
␈↓ ↓⊗ (RETURN PAT))
␈↓ εK (QUOTE ARB))
␈↓ ↓⊗ (T (SETQ LEN ('PLUS TEM LEN]
␈↓ εK (NOT MATCH])
␈↓ ↓⊗ (SETQ PAT (CDR PAT))
␈↓ εK
␈↓ ↓⊗ (GO LP])
␈↓ εK␈↓α(SUBPAT?␈↓↓
␈↓ ↓⊗
␈↓ εK [LAMBDA (PATELT)
␈↓ ↓⊗␈↓α(ELT?␈↓↓
␈↓ εK (AND (LISTP PATELT)
␈↓ ↓⊗ [LAMBDA (PATELT)
␈↓ εK (NOT (FMEMB (CAR PATELT)
␈↓ ↓⊗ (COND
␈↓ εK (QUOTE (! $$ DEFAULT = == ' : ANY ← -> !← !->])
␈↓ ↓⊗ ((NLISTP PATELT)
␈↓ εK
␈↓ ↓⊗ (SELECTQ PATELT
␈↓ εK␈↓α(NOMATCHARBCAR?␈↓↓
␈↓ ↓⊗ ((≠1 $1 & *)
␈↓ εK [LAMBDA (PAT)
␈↓ ↓⊗ T)
␈↓ εK
␈↓ ↓⊗ (($ ≠ --)
␈↓ εK
␈↓ ↓⊗ NIL)
␈↓ εK
␈↓ ↓⊗ (HELP (QUOTE "FUNNY PAT IN ELT?")
␈↓ εK
␈↓ ↓⊗ PATELT)))
␈↓ εK
␈↓ ↓⊗ (T (SELECTQ (CAR PATELT)
␈↓ εK
␈↓ ↓⊗ (DEFAULT (MAKEDEFAULT PATELT)
␈↓ εK
␈↓ ↓⊗ T)
␈↓ εK
␈↓ ↓⊗ ((= == ' :)
␈↓ εK
␈↓ ↓⊗ T)
␈↓ εK
␈↓ ↓⊗ ((-> ←)
␈↓ εK
␈↓ ↓⊗ (ELT? (CDDR PATELT)))
␈↓ εK
␈↓ ↓⊗ ((!← !-> ! $$)
␈↓ εK
␈↓ ↓⊗ NIL)
␈↓ εK (AND PAT (OR (NOMATCHARB? (CAR PAT))
␈↓ ↓⊗ T])
␈↓ εK (AND (OR (EQ (CAAR PAT)
␈↓ ↓⊗
␈↓ εK (QUOTE !->))
␈↓ ↓⊗␈↓α(MEMBPAT?␈↓↓
␈↓ εK (EQ (CAAR PAT)
␈↓ ↓⊗ [LAMBDA (PAT) (* Can a MEMB be used
␈↓ εK (QUOTE !←)))
␈↓ ↓⊗ for pat?)
␈↓ εK (NOMATCHARBCAR? (CDR PAT])
␈↓ ↓⊗ (AND (FMEMB (CAAR PAT)
␈↓ εK
␈↓ ↓⊗ (QUOTE (' = ==)))
␈↓ εK␈↓α(NULLPAT?␈↓↓
␈↓ ↓⊗ (PROG (SETS MATCH TEM3 (PAT2 (CDR PAT)))
␈↓ εK [LAMBDA (PAT)
␈↓ ↓⊗
␈↓ εK (OR (AND (NULL PAT)
␈↓ ↓⊗ (* Check if PAT ends is ($ 'foo nomatch nomatch ...
␈↓ εK (NOT NULLCHK))
␈↓ ↓⊗ Arb-nomatch ...))
␈↓ εK (AND PAT (PROG ((LSTPAT PAT))
␈↓ ↓⊗
␈↓ εK LP (COND
␈↓ ↓⊗
␈↓ εK ((NULL LSTPAT)
␈↓ ↓⊗ LP (COND
␈↓ εK (RETURN T))
␈↓ ↓⊗ ((NULL PAT2)
␈↓ εK ((NOT ($? (CAR LSTPAT)))
␈↓ ↓⊗ (RETURN))
␈↓ εK (RETURN NIL)))
␈↓ ↓⊗ ((AND (OR (EQ (SETQ TEM3 (ANALPATELT (CAR PAT2)))
␈↓ εK (SETQ LSTPAT (CDR LSTPAT))
␈↓ ↓⊗ (QUOTE ELT))
␈↓ εK (GO LP])
␈↓ ↓⊗ (NUMBERP TEM3))
␈↓ εK
␈↓ ↓⊗ (NULL MATCH))
␈↓ εK␈↓α(CANMATCHNIL␈↓↓
␈↓ ↓⊗ (SETQ PAT2 (CDR PAT2)))
␈↓ εK [LAMBDA (PATELT)
␈↓ ↓⊗ ((AND (NULL MATCH)
␈↓ εK (COND
␈↓ ↓⊗ (EQ TEM3 (QUOTE ARB)))
␈↓ εK ((NLISTP PATELT)
␈↓ ↓⊗ (RETURN PAT2))
␈↓ εK T)
␈↓ ↓⊗ (T (RETURN)))
␈↓ εK [(SUBPAT? PATELT)
␈↓ ↓⊗ (GO LP])
␈↓ εK (EVERY PATELT (FUNCTION (LAMBDA (X)
␈↓ ↓⊗
␈↓ εK (AND (NOT (ELT? X))
␈↓ ↓⊗␈↓α(ARB?␈↓↓
␈↓ εK (CANMATCHNIL X]
␈↓ ↓⊗ [LAMBDA (PATELT)
␈↓ εK ((NLISTP (CAR PATELT))
␈↓ ↓⊗ (EQ (ANALPATELT PATELT)
␈↓ εK (SELECTQ (CAR PATELT)
␈↓ ↓⊗ (QUOTE ARB])
␈↓ εK [$$ (NOT (AND (NUMBERP (CDR PATELT))
␈↓ ↓⊗
␈↓ εK (IGREATERP (CDR PATELT)
␈↓ ↓⊗␈↓α(NOMATCHARB?␈↓↓
␈↓ εK 2]
␈↓ ↓⊗ [LAMBDA (PATELT)
␈↓ εK ((← ->)
␈↓ ↓⊗ (COND
␈↓ εK (CANMATCHNIL (CDDR PATELT)))
␈↓ ↓⊗ ((NLISTP PATELT)
␈↓ εK ('(NULL (CDR PATELT)))
␈↓ ↓⊗ (ANY (PROG ((LST (CDR PATELT)))
␈↓ εK (CDAR CDR CAR)
␈↓ ↓⊗ LP (COND
␈↓ εK (CDDAAR CDR CDAAR)
␈↓ ↓⊗ ((NULL LST)
␈↓ εK (CADAAR CAR CDAAR)
␈↓ ↓⊗ (RETURN))
␈↓ εK (CDAAR CDR CAAR)
␈↓ ↓⊗ ((CANMATCHNIL (CAR LST))
␈↓ εK (CDAAAR CDR CAAAR)
␈↓ ↓⊗ (RETURN T)))
␈↓ εK (CAAAAR CAR CAAAR)
␈↓ ↓⊗ (SETQ LST (CDR LST))
␈↓ εK (CAAAR CAR CAAR)
␈↓ ↓⊗ (GO LP)))
␈↓ εK (CAAR CAR CAR]
␈↓ ↓⊗ (!
␈↓ εK (COND
␈↓ ↓⊗
␈↓ εK ((NULL TEM)
␈↓ ↓⊗ (* This isn't really right, but i'm too lazy to do
␈↓ εK X)
␈↓ ↓⊗ the analysys and will assume it can match NIL)
␈↓ εK (T (LIST (CADR TEM)
␈↓ ↓⊗
␈↓ εK (LIST (CADDR TEM)
␈↓ ↓⊗
␈↓ εK (CADR X])
␈↓ ↓⊗ T)
␈↓ εK
␈↓ ↓⊗ ((= ==)
␈↓ εK␈↓α(GENSYML␈↓↓
␈↓ ↓⊗ T)
␈↓ εK [LAMBDA (X)
␈↓ ↓⊗ (($ -- ≠)
␈↓ εK (OR (CAR (SETQ GENSYMVARLIST (CDR GENSYMVARLIST)))
␈↓ ↓⊗ (CANMATCHNIL (CDR PATELT)))
␈↓ εK (GENSYM])
␈↓ ↓⊗ T))
␈↓ εK
␈↓ ↓⊗ (T T])
␈↓ εK␈↓α(MAKESUBST␈↓↓
␈↓ ↓⊗)
␈↓ εK [LAMBDA (OLD NEW EXPR)
␈↓ ↓⊗␈↓α(DEFINEQ␈↓↓
␈↓ εK (PROG [FOUNDBEFORE (SAVNEW NEW)
␈↓ ↓⊗
␈↓ εK (EASYFNS (QUOTE (CAR CDR SETQ]
␈↓ ↓⊗␈↓α(EASYTORECOMPUTE␈↓↓
␈↓ εK (MAKESUBST1 (SETQ EXPR (COPY EXPR)))
␈↓ ↓⊗ [LAMBDA (EXPR)
␈↓ εK (RETURN EXPR])
␈↓ ↓⊗
␈↓ εK
␈↓ ↓⊗ (* If the EXPRESSION is some cadddaars of a
␈↓ εK␈↓α(MAKESUBST1␈↓↓
␈↓ ↓⊗ variable, return that variable
␈↓ εK [LAMBDA (EXPR)
␈↓ ↓⊗ (something needs to check for VARS bound IN somes
␈↓ εK (COND
␈↓ ↓⊗ and internal forms for WHEN it can't use it for the
␈↓ εK ((NLISTP EXPR)
␈↓ ↓⊗ *'s value))
␈↓ εK EXPR)
␈↓ ↓⊗
␈↓ εK ((EQ (CAR EXPR) OLD)
␈↓ ↓⊗
␈↓ εK (COND
␈↓ ↓⊗ (OR (AND (NLISTP EXPR)
␈↓ εK ((NOT FOUNDBEFORE)
␈↓ ↓⊗ EXPR)
␈↓ εK (SETQ FOUNDBEFORE EXPR))
␈↓ ↓⊗ (AND (OR (GETP (CAR EXPR)
␈↓ εK ((NLISTP FOUNDBEFORE))
␈↓ ↓⊗ (QUOTE CROPS))
␈↓ εK ((EASYTORECOMPUTE NEW)
␈↓ ↓⊗ (FMEMB (CAR EXPR)
␈↓ εK (SETQ NEW (RECOMPUTATION NEW))
␈↓ ↓⊗ EASYFNS))
␈↓ εK (SETQ FOUNDBEFORE (QUOTE RECOMPUTED)))
␈↓ ↓⊗ (EASYTORECOMPUTE (CADR EXPR])
␈↓ εK (T (RPLACA FOUNDBEFORE ('SETQ (SETQ NEW (GENSYML OLD))
␈↓ ↓⊗
␈↓ εK SAVNEW))
␈↓ ↓⊗␈↓α(EQTOMEMB␈↓↓
␈↓ εK (SETQ FOUNDBEFORE T)
␈↓ ↓⊗ [LAMBDA (EXPR)
␈↓ εK (BIND NEW)))
␈↓ ↓⊗ (LIST (SELECTQ (CAR EXPR)
␈↓ εK (RPLACA EXPR NEW)
␈↓ ↓⊗ (EQUAL (QUOTE MEMBER))
␈↓ εK (MAKESUBST1 (CDR EXPR)))
␈↓ ↓⊗ (EQ (QUOTE MEMB))
␈↓ εK (T (MAKESUBST1 (CAR EXPR))
␈↓ ↓⊗ (HELP (QUOTE "BAD EQ EXPR IN EQTOMEMB")
␈↓ εK (MAKESUBST1 (CDR EXPR])
␈↓ ↓⊗ EXPR))
␈↓ εK
␈↓ ↓⊗ (CADDR EXPR)
␈↓ εK␈↓α(FORMEXPAND␈↓↓
␈↓ ↓⊗ (CADR EXPR])
␈↓ εK [LAMBDA (LIST AT)
␈↓ ↓⊗
␈↓ εK
␈↓ ↓⊗␈↓α(FULLEXPANSION␈↓↓
␈↓ εK (* Searches for (AT --) AT the top level of list and
␈↓ ↓⊗ [LAMBDA (X)
␈↓ εK does a (1) up (bo 1) on them)
␈↓ ↓⊗ (PROG [(TEM (FASSOC (CAR X)
␈↓ εK
␈↓ ↓⊗ (QUOTE ((CDDDDR CDR CDDDR)
␈↓ εK
␈↓ ↓⊗ (CADDDR CAR CDDDR)
␈↓ εK [MAP LIST (FUNCTION (LAMBDA (X)
␈↓ ↓⊗ (CDDDR CDR CDDR)
␈↓ εK (AND (EQ (CAR (CAR X))
␈↓ ↓⊗ (CDADDR CDR CADDR)
␈↓ εK AT)
␈↓ ↓⊗ (CAADDR CAR CADDR)
␈↓ εK (RPLACD X (NCONC (CDDR (CAR X))
␈↓ ↓⊗ (CADDR CAR CDDR)
␈↓ εK (CDR X)))
␈↓ ↓⊗ (CDDR CDR CDR)
␈↓ εK (RPLACA X (CADR (CAR X]
␈↓ ↓⊗ (CDDADR CDR CDADR)
␈↓ εK LIST])
␈↓ ↓⊗ (CADADR CAR CDADR)
␈↓ εK
␈↓ ↓⊗ (CDADR CDR CADR)
␈↓ εK␈↓α(BIND␈↓↓
␈↓ ↓⊗ (CDAADR CDR CAADR)
␈↓ εK [LAMBDA (VAR)
␈↓ ↓⊗ (CAAADR CAR CAADR)
␈↓ εK (SETQ BINDINGS (CONS VAR BINDINGS])
␈↓ ↓⊗ (CAADR CAR CADR)
␈↓ εK
␈↓ ↓⊗ (CADR CAR CDR)
␈↓ εK␈↓α(BOUNDVAR␈↓↓
␈↓ ↓⊗ (CDDDAR CDR CDDAR)
␈↓ εK [LAMBDA (X)
␈↓ ↓⊗ (CADDAR CAR CDDAR)
␈↓ εK (AND X (NOT (FMEMB X SOMEVARS])
␈↓ ↓⊗ (CDDAR CDR CDAR)
␈↓ εK
␈↓ ↓⊗ (CDADAR CDR CADAR)
␈↓ εK␈↓α(RECOMPUTATION␈↓↓
␈↓ ↓⊗ (CAADAR CAR CADAR)
␈↓ εK [LAMBDA (EXPR)
␈↓ ↓⊗ (CADAR CAR CDAR)
␈↓ εK (COND
␈↓ ↓⊗ ((NLISTP EXPR)
␈↓ εK VAR))
␈↓ ↓⊗ EXPR)
␈↓ εK (T ('NTH{NUMBER⎇ (LIST (QUOTE CDDDDR)
␈↓ ↓⊗ [[OR (GETP (CAR EXPR)
␈↓ εK VAR)
␈↓ ↓⊗ (QUOTE CROPS))
␈↓ εK (IDIFFERENCE LEN 4])
␈↓ ↓⊗ (FMEMB (CAR EXPR)
␈↓ εK
␈↓ ↓⊗ (QUOTE (CAR CDR]
␈↓ εK␈↓α('OR␈↓↓
␈↓ ↓⊗ (LIST (CAR EXPR)
␈↓ εK [LAMBDA (EXPRLIST)
␈↓ ↓⊗ (EASYTORECOMPUTE (CADR EXPR]
␈↓ εK (CONS (QUOTE OR)
␈↓ ↓⊗ ((EQ (CAR EXPR)
␈↓ εK (FORMEXPAND EXPRLIST (QUOTE OR])
␈↓ ↓⊗ (QUOTE SETQ))
␈↓ εK
␈↓ ↓⊗ (CADR EXPR))
␈↓ εK␈↓α('PLUS␈↓↓
␈↓ ↓⊗ (T (HELP "CANT RECOMPUTE"])
␈↓ εK [LAMBDA (EXPR1 EXPR2)
␈↓ ↓⊗
␈↓ εK (COND
␈↓ ↓⊗␈↓α(MAKEVAR␈↓↓
␈↓ εK ((AND (NUMBERP EXPR1)
␈↓ ↓⊗ [LAMBDA (X)
␈↓ εK (NUMBERP EXPR2))
␈↓ ↓⊗ (COND
␈↓ εK (IPLUS EXPR1 EXPR2))
␈↓ ↓⊗ ((EQ X T)
␈↓ εK ((AND (NUMBERP EXPR1)
␈↓ ↓⊗ (BIND (SETQ X (GENSYML X)))
␈↓ εK (NUMBERP EXPR2))
␈↓ ↓⊗ X)
␈↓ εK (IPLUS EXPR1 EXPR2))
␈↓ ↓⊗ (T X])
␈↓ εK (T (PROG ((SUM 0)
␈↓ ↓⊗)
␈↓ εK (LST (FORMEXPAND (LIST EXPR1 EXPR2)
␈↓ ↓⊗␈↓α(DEFINEQ␈↓↓
␈↓ εK (QUOTE IPLUS)))
␈↓ ↓⊗
␈↓ εK VAL)
␈↓ ↓⊗␈↓α('NLEFT␈↓↓
␈↓ εK [MAPC LST (FUNCTION (LAMBDA (X)
␈↓ ↓⊗ [LAMBDA (EXPR N TAIL)
␈↓ εK (COND
␈↓ ↓⊗ (COND
␈↓ εK ((NUMBERP X)
␈↓ ↓⊗ (TAIL (LIST (QUOTE NLEFT)
␈↓ εK (SETQ SUM (IPLUS X SUM)))
␈↓ ↓⊗ EXPR N TAIL))
␈↓ εK (T (SETQ VAL (NCONC1 VAL X]
␈↓ ↓⊗ ((EQ N 0)
␈↓ εK (COND
␈↓ ↓⊗ ('CDR ('LAST EXPR)))
␈↓ εK ((NULL VAL)
␈↓ ↓⊗ ((EQ N 1)
␈↓ εK SUM)
␈↓ ↓⊗ ('LAST EXPR))
␈↓ εK ((IGREATERP SUM 0)
␈↓ ↓⊗ (T (LIST (QUOTE NLEFT)
␈↓ εK (CONS (QUOTE IPLUS)
␈↓ ↓⊗ EXPR N])
␈↓ εK (CONS SUM VAL)))
␈↓ ↓⊗
␈↓ εK ((NULL (CDR VAL))
␈↓ ↓⊗␈↓α('NOT␈↓↓
␈↓ εK (CAR VAL))
␈↓ ↓⊗ [LAMBDA (X)
␈↓ εK (T (CONS (QUOTE IPLUS)
␈↓ ↓⊗ (COND
␈↓ εK VAL])
␈↓ ↓⊗ ((FMEMB (CAR X)
␈↓ εK
␈↓ ↓⊗ (QUOTE (NOT NULL)))
␈↓ εK␈↓α('REPLACE␈↓↓
␈↓ ↓⊗ (CADR X))
␈↓ εK [LAMBDA (VAR EXPR)
␈↓ ↓⊗ (T (LIST (QUOTE NOT)
␈↓ εK (SETQ VAR (FULLEXPANSION VAR))
␈↓ ↓⊗ X])
␈↓ εK (COND
␈↓ ↓⊗
␈↓ εK ((EQ (CAR VAR)
␈↓ ↓⊗␈↓α('NOTLESSPLENGTH␈↓↓
␈↓ εK (QUOTE CAR))
␈↓ ↓⊗ [LAMBDA (X N)
␈↓ εK (LIST (QUOTE RPLACA)
␈↓ ↓⊗ (COND
␈↓ εK (CADR VAR)
␈↓ ↓⊗ ((ZEROP N)
␈↓ εK EXPR))
␈↓ ↓⊗ T)
␈↓ εK ((EQ (CAR VAR)
␈↓ ↓⊗ (T ('NTH X N])
␈↓ εK (QUOTE CDR))
␈↓ ↓⊗
␈↓ εK (LIST (QUOTE RPLACD)
␈↓ ↓⊗␈↓α('NTH␈↓↓
␈↓ εK (CADR VAR)
␈↓ ↓⊗ [LAMBDA (VAR LEN)
␈↓ εK EXPR))
␈↓ ↓⊗ (COND
␈↓ εK [(EQ (CAR VAR)
␈↓ ↓⊗ ((NOT (NUMBERP LEN))
␈↓ εK (QUOTE LDIFF))
␈↓ ↓⊗ (LIST (QUOTE NTH)
␈↓ εK ('REPLACE (CADR VAR)
␈↓ ↓⊗ VAR LEN))
␈↓ εK (LIST (QUOTE NCONC)
␈↓ ↓⊗ (T ('NTH{NUMBER⎇ VAR LEN])
␈↓ εK EXPR
␈↓ ↓⊗
␈↓ εK (CADDR VAR]
␈↓ ↓⊗␈↓α('NTH{NUMBER⎇␈↓↓
␈↓ εK (T (LIST (QUOTE RPLNODE)
␈↓ ↓⊗ [LAMBDA (VAR LEN)
␈↓ εK VAR EXPR])
␈↓ ↓⊗ (COND
␈↓ εK
␈↓ ↓⊗ ((EQ LEN 1)
␈↓ εK␈↓α('SETQ←SIDE←EFFECT␈↓↓
␈↓ ↓⊗ VAR)
␈↓ εK [LAMBDA (VAR VALUE LOCALORSETQFLG)
␈↓ ↓⊗ ((EQ LEN 2)
␈↓ εK (COND
␈↓ ↓⊗ (LIST (QUOTE CDR)
␈↓ εK ((OR (NOT POSTPONE←SIDE←EFFECTS)
␈↓ ↓⊗ VAR))
␈↓ εK (LOCALPATVAR VAR))
␈↓ ↓⊗ ((EQ LEN 3)
␈↓ εK ('SETQ VAR VALUE (AND MUSTBEMATCH LOCALORSETQFLG)))
␈↓ ↓⊗ (LIST (QUOTE CDDR)
␈↓ εK (T (POSTPONE ('SETQ VAR VALUE))
␈↓ ↓⊗ VAR))
␈↓ εK T])
␈↓ ↓⊗ ((EQ LEN 4)
␈↓ εK
␈↓ ↓⊗ (LIST (QUOTE CDDDR)
␈↓ εK␈↓α('REPLACE←SIDE←EFFECT␈↓↓
␈↓ ↓⊗ VAR))
␈↓ εK [LAMBDA (VAR VALUE)
␈↓ ↓⊗ ((EQ LEN 5)
␈↓ εK (COND
␈↓ ↓⊗ (LIST (QUOTE CDDDDR)
␈↓ εK [POSTPONE←SIDE←EFFECTS
␈↓ ↓⊗ (COND
␈↓ εK ((EQ EXPR2 (CADR TEM))
␈↓ ↓⊗ [(SETQ TEM (EASYTORECOMPUTE VAR))
␈↓ εK TEM)
␈↓ ↓⊗ (COND
␈↓ εK ((AND (EQ (CAR EXPR2)
␈↓ ↓⊗ ((BOUNDVAR TEM)
␈↓ εK (QUOTE AND))
␈↓ ↓⊗ (POSTPONE ('REPLACE VAR VALUE))
␈↓ εK (EQ (CADR TEM)
␈↓ ↓⊗ T)
␈↓ εK (CADR EXPR2)))
␈↓ ↓⊗ (T (POSTPONE ('REPLACE (SUBST (SETQ TEM2 (MAKEVAR T))
␈↓ εK (RPLACA (CDR EXPR2)
␈↓ ↓⊗ TEM VAR)
␈↓ εK TEM)
␈↓ ↓⊗ VALUE))
␈↓ εK EXPR2]
␈↓ ↓⊗ ('SETQ TEM2 TEM]
␈↓ εK ((EQUAL EXPR1 EXPR2)
␈↓ ↓⊗ (T (PROG (TEM2 (TEM ('REPLACE VAR VALUE)))
␈↓ εK EXPR2)
␈↓ ↓⊗ (PROG1 ('SETQ (SETQ TEM2 (MAKEVAR T))
␈↓ εK ((EQ (CAR EXPR1)
␈↓ ↓⊗ (CADR TEM))
␈↓ εK (QUOTE PROGN))
␈↓ ↓⊗ (RPLACA (CDR TEM)
␈↓ εK (SETQ TEM (LAST EXPR1))
␈↓ ↓⊗ TEM2)
␈↓ εK (RPLACA TEM ('AND (CAR TEM)
␈↓ ↓⊗ (POSTPONE TEM]
␈↓ εK EXPR2))
␈↓ ↓⊗ (T ('REPLACE VAR VALUE])
␈↓ εK EXPR1)
␈↓ ↓⊗
␈↓ εK ((AND (EQ (CAR EXPR2)
␈↓ ↓⊗␈↓α('SETQ␈↓↓
␈↓ εK (QUOTE COND))
␈↓ ↓⊗ [LAMBDA (VAR EXPRESSION 'SETQ-ORSETQFLG)
␈↓ εK (NOT (CDDR EXPR2)))
␈↓ ↓⊗ (COND
␈↓ εK (RPLACA (CADR EXPR2)
␈↓ ↓⊗ ([NOT (AND VAR (LITATOM VAR)
␈↓ εK ('AND EXPR1 (CAADR EXPR2)))
␈↓ ↓⊗ (NOT (EQ VAR T]
␈↓ εK EXPR2)
␈↓ ↓⊗ (HELP (QUOTE "TRYING TO SET NON-VARIABLE")
␈↓ εK ((EQ (CAR EXPR1)
␈↓ ↓⊗ VAR)))
␈↓ εK (QUOTE COND))
␈↓ ↓⊗ (SETQ EXPRESSION (LIST (QUOTE SETQ)
␈↓ εK (PROG (TEM)
␈↓ ↓⊗ VAR EXPRESSION))
␈↓ εK (SETQ TEM (LAST (CADR EXPR1)))
␈↓ ↓⊗ (COND
␈↓ εK (RPLACA TEM ('AND (CAR TEM)
␈↓ ↓⊗ ('SETQ-ORSETQFLG (LIST (QUOTE OR)
␈↓ εK EXPR2))
␈↓ ↓⊗ EXPRESSION T))
␈↓ εK (RETURN EXPR1)))
␈↓ ↓⊗ (T EXPRESSION])
␈↓ εK ((AND (EQ (CAR EXPR2)
␈↓ ↓⊗
␈↓ εK (QUOTE OR))
␈↓ ↓⊗␈↓α('SETVAR␈↓↓
␈↓ εK (EQ (CADDR EXPR2)
␈↓ ↓⊗ [LAMBDA (VAR EXPR LOCALORSETQFLG)
␈↓ εK T))
␈↓ ↓⊗ (COND
␈↓ εK (LIST (QUOTE COND)
␈↓ ↓⊗ [(AND VAR (NOT (EQ VAR T)))
␈↓ εK (LIST EXPR1 (CADR EXPR2)
␈↓ ↓⊗ (COND
␈↓ εK T)))
␈↓ ↓⊗ ((AND POSTPONE←SIDE←EFFECTS
␈↓ εK [(EQ (CAR EXPR2)
␈↓ ↓⊗ (LOCALPATVAR VAR))
␈↓ εK (QUOTE PROGN))
␈↓ ↓⊗ ('SETQ VAR EXPR LOCALORSETQFLG))
␈↓ εK (LIST (QUOTE COND)
␈↓ ↓⊗ ((EASYTORECOMPUTE EXPR)
␈↓ εK (CONS EXPR1 (CDR EXPR2]
␈↓ ↓⊗ (POSTPONE ('SETQ VAR EXPR))
␈↓ εK [(EQ (CAR EXPR2)
␈↓ ↓⊗ EXPR)
␈↓ εK (QUOTE AND))
␈↓ ↓⊗ (T (PROG (TEM)
␈↓ εK (COND
␈↓ ↓⊗ [POSTPONE ('SETQ VAR (SETQ TEM (MAKEVAR T]
␈↓ εK ((EQ (CAR EXPR1)
␈↓ ↓⊗ ('SETQ TEM EXPR LOCALORSETQFLG]
␈↓ εK (QUOTE AND))
␈↓ ↓⊗ (T EXPR])
␈↓ εK (NCONC EXPR1 (CDR EXPR2)))
␈↓ ↓⊗
␈↓ εK (T (RPLACD EXPR2 (CONS EXPR1 (CDR EXPR2]
␈↓ ↓⊗␈↓α('SOME␈↓↓
␈↓ εK ((EQ (CAR EXPR1)
␈↓ ↓⊗ [LAMBDA (LST ARGS EXPR)
␈↓ εK (QUOTE AND))
␈↓ ↓⊗ (LIST (QUOTE SOME)
␈↓ εK (NCONC1 EXPR1 EXPR2))
␈↓ ↓⊗ LST
␈↓ εK (T (LIST (QUOTE AND)
␈↓ ↓⊗ (LIST (QUOTE FUNCTION)
␈↓ εK EXPR1 EXPR2])
␈↓ ↓⊗ (LIST (QUOTE LAMBDA)
␈↓ εK
␈↓ ↓⊗ ARGS EXPR])
␈↓ εK␈↓α('!AND␈↓↓
␈↓ ↓⊗
␈↓ εK [LAMBDA (EXPRLIST)
␈↓ ↓⊗␈↓α('AND␈↓↓
␈↓ εK (OPTIMIZEAND (CONS (QUOTE AND)
␈↓ ↓⊗ [LAMBDA (EXPR1 EXPR2)
␈↓ εK EXPRLIST])
␈↓ ↓⊗ (PROG (TEM)
␈↓ εK
␈↓ ↓⊗ (COND
␈↓ εK␈↓α(OPTIMIZEAND␈↓↓
␈↓ ↓⊗ ((EQ EXPR1 T)
␈↓ εK [LAMBDA (EXPRESSION)
␈↓ ↓⊗ EXPR2)
␈↓ εK
␈↓ ↓⊗ ((EQ EXPR2 T)
␈↓ εK (* NOTE: NEEDS TO BE ADDED -
␈↓ ↓⊗ EXPR1)
␈↓ εK ('AND $ !X← ('OR & 'T) $ !Y←}
␈↓ ↓⊗ [(AND [OR (AND (EQ (CAR EXPR1)
␈↓ εK ('OR & T) $) -
␈↓ ↓⊗ (QUOTE SETQ))
␈↓ εK -
␈↓ ↓⊗ (SETQ TEM EXPR1))
␈↓ εK GOES TO -
␈↓ ↓⊗ (AND (EQ (CAR EXPR1)
␈↓ εK -
␈↓ ↓⊗ (QUOTE OR))
␈↓ εK <'COND < (LDIFF VAR X) ! (MAPCAR
␈↓ ↓⊗ (EQ (CAADR EXPR1)
␈↓ εK (LDIFF X Y) 'CADR) <'AND !Y>>>)
␈↓ ↓⊗ (QUOTE SETQ))
␈↓ εK
␈↓ ↓⊗ (EQ (CADDR EXPR1)
␈↓ εK
␈↓ ↓⊗ T)
␈↓ εK (PROG ((LIS EXPRESSION))
␈↓ ↓⊗ (SETQ TEM (CADR EXPR1]
␈↓ εK LP (COND
␈↓ ↓⊗ (COND
␈↓ εK [(NULL (CDR LIS))
␈↓ ↓⊗ (RETURN (COND
␈↓ εK (T (LIST (QUOTE EQ)
␈↓ ↓⊗ ((CDDR EXPRESSION)
␈↓ εK VAR EXPRESSION])
␈↓ ↓⊗ EXPRESSION)
␈↓ εK
␈↓ ↓⊗ (T (CADR EXPRESSION]
␈↓ εK␈↓α('EQLENGTH␈↓↓
␈↓ ↓⊗ ((OR (NULL (CADR LIS))
␈↓ εK [LAMBDA (VAR LEN)
␈↓ ↓⊗ (EQ (CADR LIS)
␈↓ εK (COND
␈↓ ↓⊗ T))
␈↓ εK ((NOT NULLCHK)
␈↓ ↓⊗ (RPLACD LIS (CDDR LIS)))
␈↓ εK T)
␈↓ ↓⊗ [(NLISTP (CADR LIS))
␈↓ εK ((ZEROP LEN)
␈↓ ↓⊗ (RPLACD (CDR LIS)
␈↓ εK ('NOT VAR))
␈↓ ↓⊗ (DREMOVE (CADR LIS)
␈↓ εK [(EQ LEN 1)
␈↓ ↓⊗ (CDDR LIS]
␈↓ εK ('AND VAR ('NOT ('CDR VAR]
␈↓ ↓⊗ ((EQ (CAADR LIS)
␈↓ εK [(AND (NUMBERP LEN)
␈↓ ↓⊗ (QUOTE SETQ))
␈↓ εK (ILESSP LEN 5))
␈↓ ↓⊗ (DREMOVE (CADADR LIS)
␈↓ εK ('AND (SETQ VAR ('NTH VAR LEN))
␈↓ ↓⊗ (CDR LIS)))
␈↓ εK ('NULL ('CDR VAR]
␈↓ ↓⊗ ((EQ (CAADR LIS)
␈↓ εK (T ('EQ ('LENGTH VAR)
␈↓ ↓⊗ (QUOTE AND))
␈↓ εK LEN])
␈↓ ↓⊗ (RPLACD LIS (NCONC (CDADR LIS)
␈↓ εK
␈↓ ↓⊗ (CDDR LIS)))
␈↓ εK␈↓α('EQUAL␈↓↓
␈↓ ↓⊗ (GO LP)))
␈↓ εK [LAMBDA (VAR EXPRESSION)
␈↓ ↓⊗ (SETQ LIS (CDR LIS))
␈↓ εK (COND
␈↓ ↓⊗ (GO LP])
␈↓ εK ((NULL EXPRESSION)
␈↓ ↓⊗
␈↓ εK ('NOT VAR))
␈↓ ↓⊗␈↓α('CAR␈↓↓
␈↓ εK (T (LIST (COND
␈↓ ↓⊗ [LAMBDA (X)
␈↓ εK ([OR (SMALLP EXPRESSION)
␈↓ ↓⊗ (PROG [(TEM (FASSOC (CAR X)
␈↓ εK (AND (EQ (CAR EXPRESSION)
␈↓ ↓⊗ (QUOTE ((CAR . CAAR)
␈↓ εK (QUOTE QUOTE))
␈↓ ↓⊗ (CDR . CADR)
␈↓ εK (OR (SMALLP (CADR EXPRESSION))
␈↓ ↓⊗ (CAAR . CAAAR)
␈↓ εK (LITATOM (CADR EXPRESSION]
␈↓ ↓⊗ (CADR . CAADR)
␈↓ εK (QUOTE EQ))
␈↓ ↓⊗ (CDAR . CADAR)
␈↓ εK ((NUMBERP EXPRESSION)
␈↓ ↓⊗ (CDDR . CADDR)
␈↓ εK (QUOTE EQP))
␈↓ ↓⊗ (CAAAR . CAAAAR)
␈↓ εK (T (QUOTE EQUAL)))
␈↓ ↓⊗ (CAADR . CAAADR)
␈↓ εK VAR EXPRESSION])
␈↓ ↓⊗ (CADAR . CAADAR)
␈↓ εK
␈↓ ↓⊗ (CADDR . CAADDR)
␈↓ εK␈↓α('LENGTH␈↓↓
␈↓ ↓⊗ (CDAAR . CADAAR)
␈↓ εK [LAMBDA (EXPR)
␈↓ ↓⊗ (CDADR . CADADR)
␈↓ εK (LIST (QUOTE LENGTH)
␈↓ ↓⊗ (CDDAR . CADDAR)
␈↓ εK EXPR])
␈↓ ↓⊗ (CDDDR . CADDDR]
␈↓ εK
␈↓ ↓⊗ (COND
␈↓ εK␈↓α('LISTP␈↓↓
␈↓ ↓⊗ (TEM (LIST (CDR TEM)
␈↓ εK [LAMBDA (X)
␈↓ ↓⊗ (CADR X)))
␈↓ εK (LIST (QUOTE LISTP)
␈↓ ↓⊗ (T (LIST (QUOTE CAR)
␈↓ εK X])
␈↓ ↓⊗ X])
␈↓ εK
␈↓ ↓⊗
␈↓ εK␈↓α('NULL␈↓↓
␈↓ ↓⊗␈↓α('CDR␈↓↓
␈↓ εK [LAMBDA (X)
␈↓ ↓⊗ [LAMBDA (X)
␈↓ εK (COND
␈↓ ↓⊗ (PROG [(TEM (FASSOC (CAR X)
␈↓ εK ((FMEMB (CAR X)
␈↓ ↓⊗ (QUOTE ((CAR . CDAR)
␈↓ εK (QUOTE (NOT NULL)))
␈↓ ↓⊗ (CDR . CDDR)
␈↓ εK (CADR X))
␈↓ ↓⊗ (CAAR . CDAAR)
␈↓ εK (T (LIST (QUOTE NULL)
␈↓ ↓⊗ (CADR . CDADR)
␈↓ εK X])
␈↓ ↓⊗ (CDAR . CDDAR)
␈↓ εK
␈↓ ↓⊗ (CDDR . CDDDR)
␈↓ εK␈↓α('LAST␈↓↓
␈↓ ↓⊗ (CAAAR . CDAAAR)
␈↓ εK [LAMBDA (X)
␈↓ ↓⊗ (CAADR . CDAADR)
␈↓ εK (LIST (QUOTE LAST)
␈↓ ↓⊗ (CADAR . CDADAR)
␈↓ εK X])
␈↓ ↓⊗ (CADDR . CDADDR)
␈↓ εK
␈↓ ↓⊗ (CDAAR . CDDAAR)
␈↓ εK␈↓α('TAILP␈↓↓
␈↓ ↓⊗ (CDADR . CDDADR)
␈↓ εK [LAMBDA (X Y)
␈↓ ↓⊗ (CDDAR . CDDDAR)
␈↓ εK (LIST (QUOTE TAILP)
␈↓ ↓⊗ (CDDDR . CDDDDR]
␈↓ εK X Y])
␈↓ ↓⊗ (COND
␈↓ εK
␈↓ ↓⊗ (TEM (LIST (CDR TEM)
␈↓ εK␈↓α('LDIFF␈↓↓
␈↓ ↓⊗ (CADR X)))
␈↓ εK [LAMBDA (A B)
␈↓ ↓⊗ (T (LIST (QUOTE CDR)
␈↓ εK (LIST (QUOTE LDIFF)
␈↓ ↓⊗ X])
␈↓ εK A B])
␈↓ ↓⊗
␈↓ εK
␈↓ ↓⊗␈↓α('EQ␈↓↓
␈↓ εK␈↓α('RETURN␈↓↓
␈↓ ↓⊗ [LAMBDA (VAR EXPRESSION)
␈↓ εK [LAMBDA (VALUE)
␈↓ ↓⊗ (COND
␈↓ εK (COND
␈↓ ↓⊗ ((NULL EXPRESSION)
␈↓ εK ((AND (NOT MUSTBEMATCH)
␈↓ ↓⊗ ('NULL VAR))
␈↓ εK (NULL POSTPONEDEFFECTS))
␈↓ ↓⊗ VALUE)
␈↓ εK
␈↓ ↓⊗ ((BOUNDVAR (PROG [(EASYFNS (QUOTE (CAR CDR SETQ]
␈↓ εK
␈↓ ↓⊗ (EASYTORECOMPUTE VALUE)))
␈↓ εK (PATPARSE← (CDR PAT))
␈↓ ↓⊗ (SETQ MUSTRETURN (RECOMPUTATION VALUE))
␈↓ εK (* And then "BI" CAR &
␈↓ ↓⊗ T)
␈↓ εK CDR PAT)
␈↓ ↓⊗ (T (BIND (SETQ MUSTRETURN (GENSYML VALUE)))
␈↓ εK (BI12 PAT))
␈↓ ↓⊗ ('SETQ MUSTRETURN VALUE ORSETQFLG])
␈↓ εK [$ (PATPARSE← (CDR PAT))
␈↓ ↓⊗)
␈↓ εK (COND
␈↓ ↓⊗␈↓α(DEFINEQ␈↓↓
␈↓ εK ((EQ (CADR PAT)
␈↓ ↓⊗
␈↓ εK (QUOTE 1))
␈↓ ↓⊗␈↓α(PARSE␈↓↓
␈↓ εK (RPLACA PAT (QUOTE $1))
␈↓ ↓⊗ [LAMBDA (X)
␈↓ εK (RPLACD PAT (CDDR PAT)))
␈↓ ↓⊗ (PATPARSE (COPY X])
␈↓ εK ((SMALLP (CADR PAT))
␈↓ ↓⊗
␈↓ εK (BI12 PAT)
␈↓ ↓⊗␈↓α(PATPARSE␈↓↓
␈↓ εK (RPLACA (CAR PAT)
␈↓ ↓⊗ [LAMBDA (PAT)
␈↓ εK (QUOTE $$]
␈↓ ↓⊗ (PROG (NUMLIST)
␈↓ εK (' (* NO ←'S ALLOWED OR
␈↓ ↓⊗
␈↓ εK CHECKED FOR)
␈↓ ↓⊗ (* NUMLIST is a list of the #'s that have been found
␈↓ εK (BI12 PAT))
␈↓ ↓⊗ -
␈↓ εK (%. (RPLACA PAT (QUOTE !)))
␈↓ ↓⊗ For every # that is found, an entry is added to
␈↓ εK ((& $1 ≠1 * ! --)
␈↓ ↓⊗ NUMLIST which is (NUMBER %. Pattern where the NUMBER
␈↓ εK (* These are all ok -
␈↓ ↓⊗ occured) so that later, NUMPATPARSE can go back and
␈↓ εK ! will be handled later)
␈↓ ↓⊗ change the numbered item to
␈↓ εK T)
␈↓ ↓⊗ (← (## . I) item) and thus, the thing can be saved.
␈↓ εK [←(COND
␈↓ ↓⊗ In MAKEMATCH, the thing-that-matched item will
␈↓ εK ((NOT BACKPAT)
␈↓ ↓⊗ either be bound to a variable, or passed along)
␈↓ εK (PATPARSE1 (CDDR PAT))
␈↓ ↓⊗
␈↓ εK (RETURN PAT]
␈↓ ↓⊗
␈↓ εK (COND
␈↓ ↓⊗ (SETQ PAT (PATPARSE1 PAT))
␈↓ εK [(STRINGP (CAR PAT))
␈↓ ↓⊗ (COND
␈↓ εK (RPLACA PAT (CONS (QUOTE ')
␈↓ ↓⊗ (NUMLIST (NUMPATPARSE NUMLIST)))
␈↓ εK (MKATOM (CAR PAT]
␈↓ ↓⊗ (RETURN PAT])
␈↓ εK ((AND (STRPOSL (QUOTE (! ' ≠ & - # ← = $
␈↓ ↓⊗
␈↓ εK :))
␈↓ ↓⊗␈↓α(NUMPATPARSE␈↓↓
␈↓ εK (CAR PAT)
␈↓ ↓⊗ [LAMBDA (PAT NUMLIST)
␈↓ εK 1)
␈↓ ↓⊗ (OR (NOT NUMLIST)
␈↓ εK (PATPARSEAT (DUNPACK (CAR PAT)
␈↓ ↓⊗ (HELP (QUOTE "NUMBERS NOT DONE YET")
␈↓ εK SKORLST2)
␈↓ ↓⊗ PAT])
␈↓ εK PAT))
␈↓ ↓⊗
␈↓ εK (* Otherwise, BREAK up
␈↓ ↓⊗␈↓α(PATPARSE1␈↓↓
␈↓ εK CAR PAT and try to
␈↓ ↓⊗ [LAMBDA (PAT BACKPAT)
␈↓ εK PATPARSEAT it)
␈↓ ↓⊗
␈↓ εK (GO RETRY))
␈↓ ↓⊗ (* Smashes PAT with it's parsing;
␈↓ εK (T (* Must have a variable
␈↓ ↓⊗ BACKPAT is used when there is a ← to determine if
␈↓ εK here!)
␈↓ ↓⊗ the previous thing was a !, a variable, or a pattern
␈↓ εK (SETQ TEM (QUOTE VAR]
␈↓ ↓⊗ -
␈↓ εK ((EQ (CAAR PAT)
␈↓ ↓⊗ If it was VAR or !, leave it alone -
␈↓ εK (QUOTE ANY))
␈↓ ↓⊗ If it was a pattern, then don't PATPARSE the next
␈↓ εK (PATPARSE1 (CDAR PAT)))
␈↓ ↓⊗ thing, since it's an EXPRESSION -
␈↓ εK (T (* Otherwise, all there
␈↓ ↓⊗ In the first two cases, BACKPAT should be T;
␈↓ εK is is a subpattern)
␈↓ ↓⊗ otherwise, it should be the previous thing)
␈↓ εK (PATPARSE1 (CAR PAT]
␈↓ ↓⊗
␈↓ εK [AND (CDR PAT)
␈↓ ↓⊗
␈↓ εK (NLISTP (CDR PAT))
␈↓ ↓⊗ (AND PAT
␈↓ εK (RPLACD PAT (LIST (QUOTE !)
␈↓ ↓⊗ (PROG (TEM)
␈↓ εK (CDR PAT]
␈↓ ↓⊗ RETRY
␈↓ εK (PATPARSE1 (CDR PAT)
␈↓ ↓⊗ [COND
␈↓ εK TEM)
␈↓ ↓⊗ [(NLISTP (CAR PAT))
␈↓ εK [COND
␈↓ ↓⊗ (SELECTQ (CAR PAT)
␈↓ εK [(EQ (CADR PAT)
␈↓ ↓⊗ ((= == : $$)
␈↓ εK (QUOTE ←))
␈↓ ↓⊗
␈↓ εK (COND
␈↓ ↓⊗ (* Look for ←'s in (CADR PAT) and spread it out if
␈↓ εK ((EQ (CAR PAT)
␈↓ ↓⊗ so -
␈↓ εK (QUOTE !)) (* Got (!←expr ...)
␈↓ ↓⊗ This might want to change later -
␈↓ εK change it to
␈↓ ↓⊗ (= foo←fie ...) -
␈↓ εK ((! ← . expr) ...))
␈↓ ↓⊗ (=foo ←fie ...) -
␈↓ εK (RPLACD PAT (CDDR PAT))
␈↓ ↓⊗ (=foo←fie ...) -
␈↓ εK (RPLACA PAT (QUOTE !->))
␈↓ ↓⊗ The second case is not ambiguous, but the first is -
␈↓ εK (BI12 PAT))
␈↓ ↓⊗ it's possible to handle it just like the QUOTE -
␈↓ εK [(EQ TEM (QUOTE VAR))
␈↓ ↓⊗ Never split -
␈↓ εK
␈↓ ↓⊗ Or leave it to PATPARSEAT never to split after an
␈↓ εK (* Got (VAR ← PAT ...); change it to
␈↓ ↓⊗ equal -
␈↓ εK ((← VAR . PAT) ...))
␈↓ ↓⊗ Also, need it for the (admittedly rare) case of #
␈↓ εK
␈↓ ↓⊗ 1←foo)
␈↓ εK
␈↓ ↓⊗ (COND
␈↓ εK (EQ (CADR TAIL)
␈↓ ↓⊗ ((CDDR PAT)
␈↓ εK (QUOTE =)))
␈↓ ↓⊗ (BISET PAT))
␈↓ εK (SETQ AT (QUOTE ==))
␈↓ ↓⊗ (T (HELP "NOTHING AFTER A '←' IN A PATTERN"
␈↓ εK (CDDR TAIL))
␈↓ ↓⊗ TOPPAT]
␈↓ εK ([AND (EQ (CAR TAIL)
␈↓ ↓⊗ (T
␈↓ εK (QUOTE $))
␈↓ ↓⊗
␈↓ εK (EQ (CADR TAIL)
␈↓ ↓⊗ (* Otherwise, there is a (PAT ← EXPR ...); change it
␈↓ εK 1)
␈↓ ↓⊗ to (-> expr . PAT))
␈↓ εK (NOT (SMALLP (CADDR TAIL]
␈↓ ↓⊗
␈↓ εK (* $1's are parsed as an
␈↓ ↓⊗
␈↓ εK atom)
␈↓ ↓⊗ (BIRPLAC PAT]
␈↓ εK (SETQ AT (QUOTE $1))
␈↓ ↓⊗ [(EQ (CAR PAT)
␈↓ εK (CDDR TAIL))
␈↓ ↓⊗ (QUOTE !))
␈↓ εK ((AND (EQ (CAR TAIL)
␈↓ ↓⊗ (COND
␈↓ εK (QUOTE $))
␈↓ ↓⊗ ((EQ (CAADR PAT)
␈↓ εK (EQ (CADR TAIL)
␈↓ ↓⊗ (QUOTE DEFAULT))
␈↓ εK (QUOTE $)))
␈↓ ↓⊗ (MAKE!DEFAULT PAT))
␈↓ εK (SETQ AT (QUOTE $$))
␈↓ ↓⊗ [(EQ (CAADR PAT)
␈↓ εK (CDDR TAIL))
␈↓ ↓⊗ (QUOTE ←))
␈↓ εK (T (CDR TAIL]
␈↓ ↓⊗ [RPLACA PAT (CONS (QUOTE !←)
␈↓ εK (COND
␈↓ ↓⊗ (CADR (CADR PAT]
␈↓ εK (REST (PATPARSEAT REST PAT T)
␈↓ ↓⊗ (RPLACA (CDR PAT)
␈↓ εK (ATTACH AT PAT))
␈↓ ↓⊗ (CDDR (CADR PAT]
␈↓ εK (T (RPLACA PAT AT)))
␈↓ ↓⊗ (T (BI12 PAT]
␈↓ εK (AND (NOT (EQ TAIL UNPACKEDAT))
␈↓ ↓⊗ ((EQ TEM (QUOTE VAR))
␈↓ εK (ATTACH (PACKLDIFF UNPACKEDAT TAIL)
␈↓ ↓⊗ (RPLACA PAT (CONS (QUOTE DEFAULT)
␈↓ εK PAT))
␈↓ ↓⊗ (CAR PAT]
␈↓ εK PAT)
␈↓ ↓⊗ (RETURN PAT])
␈↓ εK (FLG (RPLACA PAT (PACK UNPACKEDAT])
␈↓ ↓⊗
␈↓ εK
␈↓ ↓⊗␈↓α(PATPARSE←␈↓↓
␈↓ εK␈↓α(PACKLDIFF␈↓↓
␈↓ ↓⊗ [LAMBDA (PAT) (* Look for ←'s in
␈↓ εK [LAMBDA (L TAIL)
␈↓ ↓⊗ (CAR PAT))
␈↓ εK (PROG (TEM)
␈↓ ↓⊗ (AND (LITATOM (CAR PAT))
␈↓ εK (AND (SETQ TEM (NLEFT L 1 TAIL))
␈↓ ↓⊗ (PATPARSEAT (DUNPACK (CAR PAT)
␈↓ εK (RPLACD TEM)
␈↓ ↓⊗ SKORLST2)
␈↓ εK (PROG1 (PACK L)
␈↓ ↓⊗ PAT
␈↓ εK (RPLACD TEM TAIL])
␈↓ ↓⊗ (QUOTE (←])
␈↓ εK
␈↓ ↓⊗
␈↓ εK␈↓α(BISET␈↓↓
␈↓ ↓⊗␈↓α(BI12␈↓↓
␈↓ εK [LAMBDA (PAT)
␈↓ ↓⊗ [LAMBDA (PAT) (* This changes
␈↓ εK
␈↓ ↓⊗ (A B ...) to
␈↓ εK (* This function changes (a b c ...) to
␈↓ ↓⊗ ((A . B) ...))
␈↓ εK ((b a . c) ...))
␈↓ ↓⊗ (COND
␈↓ εK
␈↓ ↓⊗ ((OR (NLISTP PAT)
␈↓ εK
␈↓ ↓⊗ (NLISTP (CDR PAT)))
␈↓ εK (PROG ((TEM (CDR PAT)))
␈↓ ↓⊗ (ERROR "BAD ARG TO BI12" PAT)))
␈↓ εK (RPLACD PAT (CDDDR PAT))
␈↓ ↓⊗ (PROG ((TEM (CDR PAT)))
␈↓ εK (RPLACD (CDR TEM)
␈↓ ↓⊗ (RPLACD PAT (CDDR PAT))
␈↓ εK (CADR TEM))
␈↓ ↓⊗ (RPLACD TEM (CAR TEM))
␈↓ εK (RPLACA (CDR TEM)
␈↓ ↓⊗ (RPLACA TEM (CAR PAT))
␈↓ εK (CAR PAT))
␈↓ ↓⊗ (RPLACA PAT TEM])
␈↓ εK (RPLACA PAT TEM])
␈↓ ↓⊗
␈↓ εK
␈↓ ↓⊗␈↓α(PATPARSEAT␈↓↓
␈↓ εK␈↓α(BIRPLAC␈↓↓
␈↓ ↓⊗ [LAMBDA (UNPACKEDAT PAT FLG)
␈↓ εK [LAMBDA (PAT)
␈↓ ↓⊗
␈↓ εK (PROG ((TEM (CAR PAT)))
␈↓ ↓⊗ (* Parses (CAR PAT) which has been unpacked into
␈↓ εK (RPLACA PAT (CDR PAT))
␈↓ ↓⊗ UNPACKEDAT and replaces the parsing into
␈↓ εK (RPLACD PAT (CDDDR PAT))
␈↓ ↓⊗ (CAR PAT); otherwise return if can't -
␈↓ εK (RPLACD (CDAR PAT)
␈↓ ↓⊗ Unless flg is on, meaning always smash
␈↓ εK TEM)
␈↓ ↓⊗ (CAR PAT))
␈↓ εK (RPLACA (CAR PAT)
␈↓ ↓⊗
␈↓ εK (QUOTE ->])
␈↓ ↓⊗
␈↓ εK
␈↓ ↓⊗ (PROG (TAIL AT REST)
␈↓ εK␈↓α(MAKEDEFAULT␈↓↓
␈↓ ↓⊗ (RETURN (COND
␈↓ εK [LAMBDA (PATELT)
␈↓ ↓⊗ ([SETQ TAIL
␈↓ εK
␈↓ ↓⊗ (SOME UNPACKEDAT
␈↓ εK (* Turns PATELT (which is either NLISTP, or
␈↓ ↓⊗ (FUNCTION (LAMBDA (CHR)
␈↓ εK (default . atom), into the "DEFAULT" pattern -
␈↓ ↓⊗ (FMEMB CHR
␈↓ εK I.e. PATELT couldn't be parsed as a pattern -
␈↓ ↓⊗ (QUOTE (' = ← * $ # %.
␈↓ εK It is assumed that the default for an atom is an
␈↓ ↓⊗ ! ' :]
␈↓ εK element pattern))
␈↓ ↓⊗ (SETQ AT (CAR TAIL))
␈↓ εK
␈↓ ↓⊗ [SETQ REST (COND
␈↓ εK
␈↓ ↓⊗ ((AND (EQ (CAR TAIL)
␈↓ εK (COND
␈↓ ↓⊗ (QUOTE =))
␈↓ εK [(EQ (CAR PATELT)
␈↓ ↓⊗ (QUOTE DEFAULT))
␈↓ εK (GO LP])
␈↓ ↓⊗ (SELECTQ VARDEFAULT
␈↓ εK)
␈↓ ↓⊗ [(← SETQ SET)
␈↓ εK (RPAQQ POSTPONE←SIDE←EFFECTS T)
␈↓ ↓⊗ (COND
␈↓ εK (RPAQQ VARDEFAULT SET)
␈↓ ↓⊗ ([OR (FMEMB (CDR PATELT)
␈↓ εK (RPAQQ LISTPCHK NIL)
␈↓ ↓⊗ (QUOTE (NIL T)))
␈↓ εK (RPAQQ ORSETQFLG T)
␈↓ ↓⊗ (NOT (LITATOM (CDR PATELT]
␈↓ εK [RPAQQ MATCHBLOCKS
␈↓ ↓⊗ (FRPLACA PATELT (QUOTE ')))
␈↓ εK ((MATCHBLOCK MAKEMATCH 'MATCHTOP 'MATCH 'MATCHBIND 'MATCHELT
␈↓ ↓⊗ (T (FRPLACA (FRPLACD PATELT (CONS (CDR PATELT)
␈↓ εK 'MATCHEXP 'MATCHFIXED 'MATCHSUBPAT 'MATCHTAIL
␈↓ ↓⊗ (QUOTE $1)))
␈↓ εK 'MATCHSOME 'MATCHWITHMEMB 'MATCHNNIL 'MATCHEXP1
␈↓ ↓⊗ (QUOTE ←]
␈↓ εK LOCALPATVAR 'MATCH&SET 'CDRLEN POSTPONE
␈↓ ↓⊗ ((QUOTE ')
␈↓ εK NOMATCHELT? 'HEADP ANALPATELT ANALPAT MAXANAL
␈↓ ↓⊗ (FRPLACA PATELT (QUOTE ')))
␈↓ εK ANAL!PAT ABP $? SKIP$I SKIP$ SKIP$ANY ELT?
␈↓ ↓⊗ ((= EQUAL)
␈↓ εK MEMBPAT? ARB? NOMATCHARB? SUBPAT? NOMATCHARBCAR?
␈↓ ↓⊗ (FRPLACA PATELT (QUOTE =)))
␈↓ εK NULLPAT? CANMATCHNIL EASYTORECOMPUTE EQTOMEMB
␈↓ ↓⊗ (HELP (QUOTE "FUNNY VARDEFAULT"]
␈↓ εK FULLEXPANSION GENSYML MAKESUBST MAKESUBST1
␈↓ ↓⊗ (T (SELECTQ VARDEFAULT
␈↓ εK FORMEXPAND BIND BOUNDVAR RECOMPUTATION MAKEVAR
␈↓ ↓⊗ [(← SETQ SET)
␈↓ εK 'NLEFT 'NOT 'NOTLESSPLENGTH 'NTH 'NTH{NUMBER⎇ 'OR
␈↓ ↓⊗ (CONS (QUOTE ←)
␈↓ εK 'PLUS 'REPLACE 'SETQ←SIDE←EFFECT
␈↓ ↓⊗ (CONS PATELT (QUOTE $1]
␈↓ εK 'REPLACE←SIDE←EFFECT 'SETQ 'SETVAR 'SOME 'AND
␈↓ ↓⊗ ((QUOTE ')
␈↓ εK '!AND OPTIMIZEAND 'CAR 'CDR 'EQ 'EQLENGTH 'EQUAL
␈↓ ↓⊗ (CONS (QUOTE ')
␈↓ εK 'LENGTH 'LISTP 'NULL 'LAST 'TAILP 'LDIFF 'RETURN
␈↓ ↓⊗ PATELT))
␈↓ εK PARSE PATPARSE NUMPATPARSE PATPARSE1 PATPARSE←
␈↓ ↓⊗ ((= EQUAL)
␈↓ εK BI12 PATPARSEAT PACKLDIFF BISET BIRPLAC
␈↓ ↓⊗ (CONS (QUOTE =)
␈↓ εK MAKEDEFAULT MAKE!DEFAULT
␈↓ ↓⊗ PATELT))
␈↓ εK (BLKAPPLYFNS ANALPATELT ANAL!PAT 'MATCH
␈↓ ↓⊗ (HELP (QUOTE "FUNNY VARDEFAULT"])
␈↓ εK 'MATCHNNIL 'MATCHFIXED 'MATCHEXP
␈↓ ↓⊗
␈↓ εK 'CDRLEN)
␈↓ ↓⊗␈↓α(MAKE!DEFAULT␈↓↓
␈↓ εK (ENTRIES MAKEMATCH)
␈↓ ↓⊗ [LAMBDA (PAT)
␈↓ εK (GLOBALVARS VARDEFAULT LISTPCHK ORSETQFLG
␈↓ ↓⊗ (SELECTQ VARDEFAULT
␈↓ εK POSTPONE←SIDE←EFFECTS)
␈↓ ↓⊗ ((← SETQ SET)
␈↓ εK (LOCALFREEVARS TAIL TEM ISVALUE EASYFNS BINDINGS
␈↓ ↓⊗ [FRPLACA PAT (CONS (QUOTE ←)
␈↓ εK MUSTBEMATCH POSTPONEDEFFECTS
␈↓ ↓⊗ (CONS (CDR (CADR PAT))
␈↓ εK MUSTRETURN SOMEVARS GENSYMVARSLIST
␈↓ ↓⊗ (QUOTE $]
␈↓ εK MAKESUBSTVARLIST MATCH SETS
␈↓ ↓⊗ (FRPLACD PAT (CDDR PAT)))
␈↓ εK NULLCHK TOPPAT FOUNDBEFORE LEN
␈↓ ↓⊗ ((QUOTE ')
␈↓ εK GENSYMVARLIST OLD NEW SAVNEW TEM2]
␈↓ ↓⊗ (FRPLACA (CADR PAT)
␈↓ εK␈↓α(DECLARE␈↓↓
␈↓ ↓⊗ (QUOTE '))
␈↓ εK (BLOCK: MATCHBLOCK MAKEMATCH 'MATCHTOP 'MATCH 'MATCHBIND 'MATCHELT
␈↓ ↓⊗ (BI12 PAT))
␈↓ εK 'MATCHEXP 'MATCHFIXED 'MATCHSUBPAT 'MATCHTAIL 'MATCHSOME
␈↓ ↓⊗ ((= EQUAL)
␈↓ εK 'MATCHWITHMEMB 'MATCHNNIL 'MATCHEXP1 LOCALPATVAR 'MATCH&SET
␈↓ ↓⊗ (FRPLACA (CADR PAT)
␈↓ εK 'CDRLEN POSTPONE NOMATCHELT? 'HEADP ANALPATELT ANALPAT
␈↓ ↓⊗ (QUOTE =))
␈↓ εK MAXANAL ANAL!PAT ABP $? SKIP$I SKIP$ SKIP$ANY ELT? MEMBPAT?
␈↓ ↓⊗ (BI12 PAT))
␈↓ εK ARB? NOMATCHARB? SUBPAT? NOMATCHARBCAR? NULLPAT? CANMATCHNIL
␈↓ ↓⊗ (HELP (QUOTE "FUNNY VARDEFAULT"])
␈↓ εK EASYTORECOMPUTE EQTOMEMB FULLEXPANSION GENSYML MAKESUBST
␈↓ ↓⊗)
␈↓ εK MAKESUBST1 FORMEXPAND BIND BOUNDVAR RECOMPUTATION MAKEVAR
␈↓ ↓⊗␈↓α(DEFINEQ␈↓↓
␈↓ εK 'NLEFT 'NOT 'NOTLESSPLENGTH 'NTH 'NTH{NUMBER⎇ 'OR 'PLUS
␈↓ ↓⊗
␈↓ εK 'REPLACE 'SETQ←SIDE←EFFECT 'REPLACE←SIDE←EFFECT 'SETQ 'SETVAR
␈↓ ↓⊗␈↓α(HEADP␈↓↓
␈↓ εK 'SOME 'AND '!AND OPTIMIZEAND 'CAR 'CDR 'EQ 'EQLENGTH 'EQUAL
␈↓ ↓⊗ [LAMBDA (A B)
␈↓ εK 'LENGTH 'LISTP 'NULL 'LAST 'TAILP 'LDIFF 'RETURN PARSE
␈↓ ↓⊗ (PROG NIL
␈↓ εK PATPARSE NUMPATPARSE PATPARSE1 PATPARSE← BI12 PATPARSEAT
␈↓ ↓⊗ LP (COND
␈↓ εK PACKLDIFF BISET BIRPLAC MAKEDEFAULT MAKE!DEFAULT
␈↓ ↓⊗ ((NULL A)
␈↓ εK (BLKAPPLYFNS ANALPATELT ANAL!PAT 'MATCH 'MATCHNNIL
␈↓ ↓⊗ (RETURN (OR B T)))
␈↓ εK 'MATCHFIXED 'MATCHEXP 'CDRLEN)
␈↓ ↓⊗ ((NLISTP A)
␈↓ εK (ENTRIES MAKEMATCH)
␈↓ ↓⊗ (RETURN (EQ A B)))
␈↓ εK (GLOBALVARS VARDEFAULT LISTPCHK ORSETQFLG
␈↓ ↓⊗ ([OR (NLISTP B)
␈↓ εK POSTPONE←SIDE←EFFECTS)
␈↓ ↓⊗ (NOT (EQUAL (CAR A)
␈↓ εK (LOCALFREEVARS TAIL TEM ISVALUE EASYFNS BINDINGS MUSTBEMATCH
␈↓ ↓⊗ (CAR B]
␈↓ εK POSTPONEDEFFECTS MUSTRETURN SOMEVARS
␈↓ ↓⊗ (RETURN NIL)))
␈↓ εK GENSYMVARSLIST MAKESUBSTVARLIST MATCH SETS
␈↓ ↓⊗ (SETQ A (CDR A))
␈↓ εK NULLCHK TOPPAT FOUNDBEFORE LEN GENSYMVARLIST
␈↓ ↓⊗ (SETQ B (CDR B))
␈↓ εK OLD NEW SAVNEW TEM2))
␈↓ ↓⊗␈↓ εK)(DEFLIST(QUOTE(
␈↓ ↓⊗␈↓ εK [EVERY
␈↓ ↓⊗␈↓ εK (X
␈↓ ↓⊗␈↓ εK (PROG
␈↓ ↓⊗␈↓ εK (LL Q)
␈↓ ↓⊗␈↓ εK (RETURN
␈↓ ↓⊗␈↓ εK (SUBPAIR
␈↓ ↓⊗␈↓ εK (QUOTE (MAPX MAPCF MAPCF2 B))
␈↓ ↓⊗␈↓ εK (LIST
␈↓ ↓⊗␈↓ εK (CAR X)
␈↓ ↓⊗␈↓ εK [COND [(SETQ Q (CFNP (CADR X)))
␈↓ ↓⊗␈↓ εK (CONS Q (QUOTE ((CAR MACROX)
␈↓ ↓⊗␈↓ εK MACROX]
␈↓ ↓⊗ (T [SETQ LL (CONS (LIST (QUOTE MACROF)
␈↓ ↓⊗ (CADR X]
␈↓ ↓⊗ (QUOTE (APPLY* MACROF (CAR MACROX)
␈↓ ↓⊗ MACROX]
␈↓ ↓⊗ [COND
␈↓ ↓⊗ [(CDDR X)
␈↓ ↓⊗ (COND
␈↓ ↓⊗ [(SETQ Q (CFNP (CADDR X)))
␈↓ ↓⊗ (CONS Q (QUOTE (MACROX]
␈↓ ↓⊗ (T (SETQ LL
␈↓ ↓⊗ (CONS [LIST (QUOTE MACROF2)
␈↓ ↓⊗ (LIST (QUOTE OR)
␈↓ ↓⊗ (CADDR X)
␈↓ ↓⊗ (QUOTE (QUOTE CDR]
␈↓ ↓⊗ LL))
␈↓ ↓⊗ (QUOTE (APPLY* MACROF2 MACROX]
␈↓ ↓⊗ (T (QUOTE (CDR MACROX]
␈↓ ↓⊗ LL)
␈↓ ↓⊗ (QUOTE (PROG ((MACROX MAPX) . B)
␈↓ ↓⊗ MAPCLP
␈↓ ↓⊗ (COND ((NLISTP MACROX)
␈↓ ↓⊗ (RETURN T))
␈↓ ↓⊗ ((NOT MAPCF)
␈↓ ↓⊗ (RETURN NIL)))
␈↓ ↓⊗ (SETQ MACROX MAPCF2)
␈↓ ↓⊗ (GO MAPCLP]
␈↓ ↓⊗ [SOME
␈↓ ↓⊗ (X
␈↓ ↓⊗ (PROG
␈↓ ↓⊗ (LL Q)
␈↓ ↓⊗ (RETURN
␈↓ ↓⊗ (SUBPAIR
␈↓ ↓⊗ (QUOTE (MAPX MAPCF MAPCF2 B))
␈↓ ↓⊗ (LIST
␈↓ ↓⊗ (CAR X)
␈↓ ↓⊗ [COND [(SETQ Q (CFNP (CADR X)))
␈↓ ↓⊗ (CONS Q (QUOTE ((CAR MACROX)
␈↓ ↓⊗ MACROX]
␈↓ ↓⊗ (T [SETQ LL (CONS (LIST (QUOTE MACROF)
␈↓ ↓⊗ (CADR X]
␈↓ ↓⊗ (QUOTE (APPLY* MACROF (CAR MACROX)
␈↓ ↓⊗ MACROX]
␈↓ ↓⊗ [COND
␈↓ ↓⊗ [(CDDR X)
␈↓ ↓⊗ (COND
␈↓ ↓⊗ [(SETQ Q (CFNP (CADDR X)))
␈↓ ↓⊗ (CONS Q (QUOTE (MACROX]
␈↓ ↓⊗ (T (SETQ LL
␈↓ ↓⊗ (CONS [LIST (QUOTE MACROF2)
␈↓ ↓⊗ (LIST (QUOTE OR)
␈↓ ↓⊗ (CADDR X)
␈↓ ↓⊗ (QUOTE (QUOTE CDR]
␈↓ ↓⊗ LL))
␈↓ ↓⊗ (QUOTE (APPLY* MACROF2 MACROX]
␈↓ ↓⊗ (T (QUOTE (CDR MACROX]
␈↓ ↓⊗ LL)
␈↓ ↓⊗ (QUOTE (PROG ((MACROX MAPX) . B)
␈↓ ↓⊗ MAPCLP
␈↓ ↓⊗ (COND ((NLISTP MACROX)
␈↓ ↓⊗ (RETURN NIL))
␈↓ ↓⊗ (MAPCF (RETURN MACROX)))
␈↓ ↓⊗ (SETQ MACROX MAPCF2)
␈↓ ↓⊗ (GO MAPCLP]
␈↓ ↓⊗))(QUOTE MACRO))
␈↓ ↓⊗
␈↓ ↓⊗STOP
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗